gcc/ada/prj-util.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              P R J . U T I L                             --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2009, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Ada.Unchecked_Deallocation;
  27
  28 with GNAT.Case_Util; use GNAT.Case_Util;
  29
  30 with Osint;    use Osint;
  31 with Output;   use Output;
  32 with Prj.Com;
  33 with Snames;   use Snames;
  34 with Targparm; use Targparm;
  35
  36 package body Prj.Util is
  37
  38    procedure Free is new Ada.Unchecked_Deallocation
  39      (Text_File_Data, Text_File);
  40
  41    -----------
  42    -- Close --
  43    -----------
  44
  45    procedure Close (File : in out Text_File) is
  46    begin
  47       if File = null then
  48          Prj.Com.Fail ("Close attempted on an invalid Text_File");
  49       end if;
  50
  51       --  Close file, no need to test status, since this is a file that we
  52       --  read, and the file was read successfully before we closed it.
  53
  54       Close (File.FD);
  55       Free (File);
  56    end Close;
  57
  58    ---------------
  59    -- Duplicate --
  60    ---------------
  61
  62    procedure Duplicate
  63      (This    : in out Name_List_Index;
  64       In_Tree : Project_Tree_Ref)
  65    is
  66       Old_Current : Name_List_Index;
  67       New_Current : Name_List_Index;
  68
  69    begin
  70       if This /= No_Name_List then
  71          Old_Current := This;
  72          Name_List_Table.Increment_Last (In_Tree.Name_Lists);
  73          New_Current := Name_List_Table.Last (In_Tree.Name_Lists);
  74          This := New_Current;
  75          In_Tree.Name_Lists.Table (New_Current) :=
  76            (In_Tree.Name_Lists.Table (Old_Current).Name, No_Name_List);
  77
  78          loop
  79             Old_Current := In_Tree.Name_Lists.Table (Old_Current).Next;
  80             exit when Old_Current = No_Name_List;
  81             In_Tree.Name_Lists.Table (New_Current).Next := New_Current + 1;
  82             Name_List_Table.Increment_Last (In_Tree.Name_Lists);
  83             New_Current := New_Current + 1;
  84             In_Tree.Name_Lists.Table (New_Current) :=
  85               (In_Tree.Name_Lists.Table (Old_Current).Name, No_Name_List);
  86          end loop;
  87       end if;
  88    end Duplicate;
  89
  90    -----------------
  91    -- End_Of_File --
  92    -----------------
  93
  94    function End_Of_File (File : Text_File) return Boolean is
  95    begin
  96       if File = null then
  97          Prj.Com.Fail ("End_Of_File attempted on an invalid Text_File");
  98       end if;
  99
 100       return File.End_Of_File_Reached;
 101    end End_Of_File;
 102
 103    -------------------
 104    -- Executable_Of --
 105    -------------------
 106
 107    function Executable_Of
 108      (Project  : Project_Id;
 109       In_Tree  : Project_Tree_Ref;
 110       Main     : File_Name_Type;
 111       Index    : Int;
 112       Ada_Main : Boolean := True;
 113       Language : String := "") return File_Name_Type
 114    is
 115       pragma Assert (Project /= No_Project);
 116
 117       The_Packages : constant Package_Id := Project.Decl.Packages;
 118
 119       Builder_Package : constant Prj.Package_Id :=
 120                           Prj.Util.Value_Of
 121                             (Name        => Name_Builder,
 122                              In_Packages => The_Packages,
 123                              In_Tree     => In_Tree);
 124
 125       Executable : Variable_Value :=
 126                      Prj.Util.Value_Of
 127                        (Name                    => Name_Id (Main),
 128                         Index                   => Index,
 129                         Attribute_Or_Array_Name => Name_Executable,
 130                         In_Package              => Builder_Package,
 131                         In_Tree                 => In_Tree);
 132
 133       Executable_Suffix_Name : Name_Id := No_Name;
 134
 135       Lang   : Language_Ptr;
 136
 137       Spec_Suffix : Name_Id := No_Name;
 138       Body_Suffix : Name_Id := No_Name;
 139
 140       Spec_Suffix_Length : Natural := 0;
 141       Body_Suffix_Length : Natural := 0;
 142
 143       procedure Get_Suffixes
 144         (B_Suffix : File_Name_Type;
 145          S_Suffix : File_Name_Type);
 146       --  Get the non empty suffixes in variables Spec_Suffix and Body_Suffix
 147
 148       ------------------
 149       -- Get_Suffixes --
 150       ------------------
 151
 152       procedure Get_Suffixes
 153         (B_Suffix : File_Name_Type;
 154          S_Suffix : File_Name_Type)
 155       is
 156       begin
 157          if B_Suffix /= No_File then
 158             Body_Suffix := Name_Id (B_Suffix);
 159             Body_Suffix_Length := Natural (Length_Of_Name (Body_Suffix));
 160          end if;
 161
 162          if S_Suffix /= No_File then
 163             Spec_Suffix := Name_Id (S_Suffix);
 164             Spec_Suffix_Length := Natural (Length_Of_Name (Spec_Suffix));
 165          end if;
 166       end Get_Suffixes;
 167
 168    --  Start of processing for Executable_Of
 169
 170    begin
 171       if Ada_Main then
 172          Lang := Get_Language_From_Name (Project, "ada");
 173       elsif Language /= "" then
 174          Lang := Get_Language_From_Name (Project, Language);
 175       end if;
 176
 177       if Lang /= null then
 178          Get_Suffixes
 179            (B_Suffix => Lang.Config.Naming_Data.Body_Suffix,
 180             S_Suffix => Lang.Config.Naming_Data.Spec_Suffix);
 181       end if;
 182
 183       if Builder_Package /= No_Package then
 184          Executable_Suffix_Name := Project.Config.Executable_Suffix;
 185
 186          if Executable = Nil_Variable_Value and then Ada_Main then
 187             Get_Name_String (Main);
 188
 189             --  Try as index the name minus the implementation suffix or minus
 190             --  the specification suffix.
 191
 192             declare
 193                Name : constant String (1 .. Name_Len) :=
 194                         Name_Buffer (1 .. Name_Len);
 195                Last : Positive := Name_Len;
 196
 197                Truncated : Boolean := False;
 198
 199             begin
 200                if Body_Suffix /= No_Name
 201                  and then Last > Natural (Length_Of_Name (Body_Suffix))
 202                  and then Name (Last - Body_Suffix_Length + 1 .. Last) =
 203                             Get_Name_String (Body_Suffix)
 204                then
 205                   Truncated := True;
 206                   Last := Last - Body_Suffix_Length;
 207                end if;
 208
 209                if Spec_Suffix /= No_Name
 210                  and then not Truncated
 211                  and then Last > Spec_Suffix_Length
 212                  and then Name (Last - Spec_Suffix_Length + 1 .. Last) =
 213                             Get_Name_String (Spec_Suffix)
 214                then
 215                   Truncated := True;
 216                   Last := Last - Spec_Suffix_Length;
 217                end if;
 218
 219                if Truncated then
 220                   Name_Len := Last;
 221                   Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
 222                   Executable :=
 223                     Prj.Util.Value_Of
 224                       (Name                    => Name_Find,
 225                        Index                   => 0,
 226                        Attribute_Or_Array_Name => Name_Executable,
 227                        In_Package              => Builder_Package,
 228                        In_Tree                 => In_Tree);
 229                end if;
 230             end;
 231          end if;
 232
 233          --  If we have found an Executable attribute, return its value,
 234          --  possibly suffixed by the executable suffix.
 235
 236          if Executable /= Nil_Variable_Value
 237            and then Executable.Value /= No_Name
 238            and then Length_Of_Name (Executable.Value) /= 0
 239          then
 240             --  Get the executable name. If Executable_Suffix is defined,
 241             --  make sure that it will be the extension of the executable.
 242
 243             declare
 244                Saved_EEOT : constant Name_Id := Executable_Extension_On_Target;
 245                Result     : File_Name_Type;
 246
 247             begin
 248                if Executable_Suffix_Name /= No_Name then
 249                   Executable_Extension_On_Target := Executable_Suffix_Name;
 250                end if;
 251
 252                Result :=  Executable_Name (File_Name_Type (Executable.Value));
 253                Executable_Extension_On_Target := Saved_EEOT;
 254                return Result;
 255             end;
 256          end if;
 257       end if;
 258
 259       Get_Name_String (Main);
 260
 261       --  If there is a body suffix or a spec suffix, remove this suffix,
 262       --  otherwise remove any suffix ('.' followed by other characters), if
 263       --  there is one.
 264
 265       if Body_Suffix /= No_Name
 266          and then Name_Len > Body_Suffix_Length
 267          and then Name_Buffer (Name_Len - Body_Suffix_Length + 1 .. Name_Len) =
 268                     Get_Name_String (Body_Suffix)
 269       then
 270          --  Found the body termination, remove it
 271
 272          Name_Len := Name_Len - Body_Suffix_Length;
 273
 274       elsif Spec_Suffix /= No_Name
 275             and then Name_Len > Spec_Suffix_Length
 276             and then
 277               Name_Buffer (Name_Len - Spec_Suffix_Length + 1 .. Name_Len) =
 278                 Get_Name_String (Spec_Suffix)
 279       then
 280          --  Found the spec termination, remove it
 281
 282          Name_Len := Name_Len - Spec_Suffix_Length;
 283
 284       else
 285          --  Remove any suffix, if there is one
 286
 287          Get_Name_String (Strip_Suffix (Main));
 288       end if;
 289
 290       --  Get the executable name. If Executable_Suffix is defined in the
 291       --  configuration, make sure that it will be the extension of the
 292       --  executable.
 293
 294       declare
 295          Saved_EEOT : constant Name_Id := Executable_Extension_On_Target;
 296          Result     : File_Name_Type;
 297
 298       begin
 299          if Project.Config.Executable_Suffix /= No_Name then
 300             Executable_Extension_On_Target :=
 301               Project.Config.Executable_Suffix;
 302          end if;
 303
 304          Result := Executable_Name (Name_Find);
 305          Executable_Extension_On_Target := Saved_EEOT;
 306          return Result;
 307       end;
 308    end Executable_Of;
 309
 310    --------------
 311    -- Get_Line --
 312    --------------
 313
 314    procedure Get_Line
 315      (File : Text_File;
 316       Line : out String;
 317       Last : out Natural)
 318    is
 319       C : Character;
 320
 321       procedure Advance;
 322
 323       -------------
 324       -- Advance --
 325       -------------
 326
 327       procedure Advance is
 328       begin
 329          if File.Cursor = File.Buffer_Len then
 330             File.Buffer_Len :=
 331               Read
 332                (FD => File.FD,
 333                 A  => File.Buffer'Address,
 334                 N  => File.Buffer'Length);
 335
 336             if File.Buffer_Len = 0 then
 337                File.End_Of_File_Reached := True;
 338                return;
 339             else
 340                File.Cursor := 1;
 341             end if;
 342
 343          else
 344             File.Cursor := File.Cursor + 1;
 345          end if;
 346       end Advance;
 347
 348    --  Start of processing for Get_Line
 349
 350    begin
 351       if File = null then
 352          Prj.Com.Fail ("Get_Line attempted on an invalid Text_File");
 353       end if;
 354
 355       Last := Line'First - 1;
 356
 357       if not File.End_Of_File_Reached then
 358          loop
 359             C := File.Buffer (File.Cursor);
 360             exit when C = ASCII.CR or else C = ASCII.LF;
 361             Last := Last + 1;
 362             Line (Last) := C;
 363             Advance;
 364
 365             if File.End_Of_File_Reached then
 366                return;
 367             end if;
 368
 369             exit when Last = Line'Last;
 370          end loop;
 371
 372          if C = ASCII.CR or else C = ASCII.LF then
 373             Advance;
 374
 375             if File.End_Of_File_Reached then
 376                return;
 377             end if;
 378          end if;
 379
 380          if C = ASCII.CR
 381            and then File.Buffer (File.Cursor) = ASCII.LF
 382          then
 383             Advance;
 384          end if;
 385       end if;
 386    end Get_Line;
 387
 388    --------------
 389    -- Is_Valid --
 390    --------------
 391
 392    function Is_Valid (File : Text_File) return Boolean is
 393    begin
 394       return File /= null;
 395    end Is_Valid;
 396
 397    ----------
 398    -- Open --
 399    ----------
 400
 401    procedure Open (File : out Text_File; Name : String) is
 402       FD        : File_Descriptor;
 403       File_Name : String (1 .. Name'Length + 1);
 404
 405    begin
 406       File_Name (1 .. Name'Length) := Name;
 407       File_Name (File_Name'Last) := ASCII.NUL;
 408       FD := Open_Read (Name => File_Name'Address,
 409                        Fmode => GNAT.OS_Lib.Text);
 410
 411       if FD = Invalid_FD then
 412          File := null;
 413
 414       else
 415          File := new Text_File_Data;
 416          File.FD := FD;
 417          File.Buffer_Len :=
 418            Read (FD => FD,
 419                  A  => File.Buffer'Address,
 420                  N  => File.Buffer'Length);
 421
 422          if File.Buffer_Len = 0 then
 423             File.End_Of_File_Reached := True;
 424          else
 425             File.Cursor := 1;
 426          end if;
 427       end if;
 428    end Open;
 429
 430    ---------
 431    -- Put --
 432    ---------
 433
 434    procedure Put
 435      (Into_List  : in out Name_List_Index;
 436       From_List  : String_List_Id;
 437       In_Tree    : Project_Tree_Ref;
 438       Lower_Case : Boolean := False)
 439    is
 440       Current_Name : Name_List_Index;
 441       List         : String_List_Id;
 442       Element      : String_Element;
 443       Last         : Name_List_Index :=
 444                        Name_List_Table.Last (In_Tree.Name_Lists);
 445       Value        : Name_Id;
 446
 447    begin
 448       Current_Name := Into_List;
 449       while Current_Name /= No_Name_List
 450         and then In_Tree.Name_Lists.Table (Current_Name).Next /= No_Name_List
 451       loop
 452          Current_Name := In_Tree.Name_Lists.Table (Current_Name).Next;
 453       end loop;
 454
 455       List := From_List;
 456       while List /= Nil_String loop
 457          Element := In_Tree.String_Elements.Table (List);
 458          Value := Element.Value;
 459
 460          if Lower_Case then
 461             Get_Name_String (Value);
 462             To_Lower (Name_Buffer (1 .. Name_Len));
 463             Value := Name_Find;
 464          end if;
 465
 466          Name_List_Table.Append
 467            (In_Tree.Name_Lists, (Name => Value, Next => No_Name_List));
 468
 469          Last := Last + 1;
 470
 471          if Current_Name = No_Name_List then
 472             Into_List := Last;
 473
 474          else
 475             In_Tree.Name_Lists.Table (Current_Name).Next := Last;
 476          end if;
 477
 478          Current_Name := Last;
 479
 480          List := Element.Next;
 481       end loop;
 482    end Put;
 483
 484    --------------
 485    -- Value_Of --
 486    --------------
 487
 488    function Value_Of
 489      (Variable : Variable_Value;
 490       Default  : String) return String
 491    is
 492    begin
 493       if Variable.Kind /= Single
 494         or else Variable.Default
 495         or else Variable.Value = No_Name
 496       then
 497          return Default;
 498       else
 499          return Get_Name_String (Variable.Value);
 500       end if;
 501    end Value_Of;
 502
 503    function Value_Of
 504      (Index    : Name_Id;
 505       In_Array : Array_Element_Id;
 506       In_Tree  : Project_Tree_Ref) return Name_Id
 507    is
 508       Current    : Array_Element_Id;
 509       Element    : Array_Element;
 510       Real_Index : Name_Id := Index;
 511
 512    begin
 513       Current := In_Array;
 514
 515       if Current = No_Array_Element then
 516          return No_Name;
 517       end if;
 518
 519       Element := In_Tree.Array_Elements.Table (Current);
 520
 521       if not Element.Index_Case_Sensitive then
 522          Get_Name_String (Index);
 523          To_Lower (Name_Buffer (1 .. Name_Len));
 524          Real_Index := Name_Find;
 525       end if;
 526
 527       while Current /= No_Array_Element loop
 528          Element := In_Tree.Array_Elements.Table (Current);
 529
 530          if Real_Index = Element.Index then
 531             exit when Element.Value.Kind /= Single;
 532             exit when Element.Value.Value = Empty_String;
 533             return Element.Value.Value;
 534          else
 535             Current := Element.Next;
 536          end if;
 537       end loop;
 538
 539       return No_Name;
 540    end Value_Of;
 541
 542    function Value_Of
 543      (Index                  : Name_Id;
 544       Src_Index              : Int := 0;
 545       In_Array               : Array_Element_Id;
 546       In_Tree                : Project_Tree_Ref;
 547       Force_Lower_Case_Index : Boolean := False) return Variable_Value
 548    is
 549       Current      : Array_Element_Id;
 550       Element      : Array_Element;
 551       Real_Index_1 : Name_Id;
 552       Real_Index_2 : Name_Id;
 553
 554    begin
 555       Current := In_Array;
 556
 557       if Current = No_Array_Element then
 558          return Nil_Variable_Value;
 559       end if;
 560
 561       Element := In_Tree.Array_Elements.Table (Current);
 562
 563       Real_Index_1 := Index;
 564
 565       if not Element.Index_Case_Sensitive or else Force_Lower_Case_Index then
 566          if Index /= All_Other_Names then
 567             Get_Name_String (Index);
 568             To_Lower (Name_Buffer (1 .. Name_Len));
 569             Real_Index_1 := Name_Find;
 570          end if;
 571       end if;
 572
 573       while Current /= No_Array_Element loop
 574          Element := In_Tree.Array_Elements.Table (Current);
 575          Real_Index_2 := Element.Index;
 576
 577          if not Element.Index_Case_Sensitive
 578            or else Force_Lower_Case_Index
 579          then
 580             if Element.Index /= All_Other_Names then
 581                Get_Name_String (Element.Index);
 582                To_Lower (Name_Buffer (1 .. Name_Len));
 583                Real_Index_2 := Name_Find;
 584             end if;
 585          end if;
 586
 587          if Real_Index_1 = Real_Index_2 and then
 588            Src_Index = Element.Src_Index
 589          then
 590             return Element.Value;
 591          else
 592             Current := Element.Next;
 593          end if;
 594       end loop;
 595
 596       return Nil_Variable_Value;
 597    end Value_Of;
 598
 599    function Value_Of
 600      (Name                    : Name_Id;
 601       Index                   : Int := 0;
 602       Attribute_Or_Array_Name : Name_Id;
 603       In_Package              : Package_Id;
 604       In_Tree                 : Project_Tree_Ref;
 605       Force_Lower_Case_Index  : Boolean := False) return Variable_Value
 606    is
 607       The_Array     : Array_Element_Id;
 608       The_Attribute : Variable_Value := Nil_Variable_Value;
 609
 610    begin
 611       if In_Package /= No_Package then
 612
 613          --  First, look if there is an array element that fits
 614
 615          The_Array :=
 616            Value_Of
 617              (Name      => Attribute_Or_Array_Name,
 618               In_Arrays => In_Tree.Packages.Table (In_Package).Decl.Arrays,
 619               In_Tree   => In_Tree);
 620          The_Attribute :=
 621            Value_Of
 622              (Index                  => Name,
 623               Src_Index              => Index,
 624               In_Array               => The_Array,
 625               In_Tree                => In_Tree,
 626               Force_Lower_Case_Index => Force_Lower_Case_Index);
 627
 628          --  If there is no array element, look for a variable
 629
 630          if The_Attribute = Nil_Variable_Value then
 631             The_Attribute :=
 632               Value_Of
 633                 (Variable_Name => Attribute_Or_Array_Name,
 634                  In_Variables  => In_Tree.Packages.Table
 635                                     (In_Package).Decl.Attributes,
 636                  In_Tree       => In_Tree);
 637          end if;
 638       end if;
 639
 640       return The_Attribute;
 641    end Value_Of;
 642
 643    function Value_Of
 644      (Index     : Name_Id;
 645       In_Array  : Name_Id;
 646       In_Arrays : Array_Id;
 647       In_Tree   : Project_Tree_Ref) return Name_Id
 648    is
 649       Current   : Array_Id;
 650       The_Array : Array_Data;
 651
 652    begin
 653       Current := In_Arrays;
 654       while Current /= No_Array loop
 655          The_Array := In_Tree.Arrays.Table (Current);
 656          if The_Array.Name = In_Array then
 657             return Value_Of
 658               (Index, In_Array => The_Array.Value, In_Tree => In_Tree);
 659          else
 660             Current := The_Array.Next;
 661          end if;
 662       end loop;
 663
 664       return No_Name;
 665    end Value_Of;
 666
 667    function Value_Of
 668      (Name      : Name_Id;
 669       In_Arrays : Array_Id;
 670       In_Tree   : Project_Tree_Ref) return Array_Element_Id
 671    is
 672       Current   : Array_Id;
 673       The_Array : Array_Data;
 674
 675    begin
 676       Current := In_Arrays;
 677       while Current /= No_Array loop
 678          The_Array := In_Tree.Arrays.Table (Current);
 679
 680          if The_Array.Name = Name then
 681             return The_Array.Value;
 682          else
 683             Current := The_Array.Next;
 684          end if;
 685       end loop;
 686
 687       return No_Array_Element;
 688    end Value_Of;
 689
 690    function Value_Of
 691      (Name        : Name_Id;
 692       In_Packages : Package_Id;
 693       In_Tree     : Project_Tree_Ref) return Package_Id
 694    is
 695       Current     : Package_Id;
 696       The_Package : Package_Element;
 697
 698    begin
 699       Current := In_Packages;
 700       while Current /= No_Package loop
 701          The_Package := In_Tree.Packages.Table (Current);
 702          exit when The_Package.Name /= No_Name
 703            and then The_Package.Name = Name;
 704          Current := The_Package.Next;
 705       end loop;
 706
 707       return Current;
 708    end Value_Of;
 709
 710    function Value_Of
 711      (Variable_Name : Name_Id;
 712       In_Variables  : Variable_Id;
 713       In_Tree       : Project_Tree_Ref) return Variable_Value
 714    is
 715       Current      : Variable_Id;
 716       The_Variable : Variable;
 717
 718    begin
 719       Current := In_Variables;
 720       while Current /= No_Variable loop
 721          The_Variable :=
 722            In_Tree.Variable_Elements.Table (Current);
 723
 724          if Variable_Name = The_Variable.Name then
 725             return The_Variable.Value;
 726          else
 727             Current := The_Variable.Next;
 728          end if;
 729       end loop;
 730
 731       return Nil_Variable_Value;
 732    end Value_Of;
 733
 734    ---------------
 735    -- Write_Str --
 736    ---------------
 737
 738    procedure Write_Str
 739      (S          : String;
 740       Max_Length : Positive;
 741       Separator  : Character)
 742    is
 743       First : Positive := S'First;
 744       Last  : Natural  := S'Last;
 745
 746    begin
 747       --  Nothing to do for empty strings
 748
 749       if S'Length > 0 then
 750
 751          --  Start on a new line if current line is already longer than
 752          --  Max_Length.
 753
 754          if Positive (Column) >= Max_Length then
 755             Write_Eol;
 756          end if;
 757
 758          --  If length of remainder is longer than Max_Length, we need to
 759          --  cut the remainder in several lines.
 760
 761          while Positive (Column) + S'Last - First > Max_Length loop
 762
 763             --  Try the maximum length possible
 764
 765             Last := First + Max_Length - Positive (Column);
 766
 767             --  Look for last Separator in the line
 768
 769             while Last >= First and then S (Last) /= Separator loop
 770                Last := Last - 1;
 771             end loop;
 772
 773             --  If we do not find a separator, we output the maximum length
 774             --  possible.
 775
 776             if Last < First then
 777                Last := First + Max_Length - Positive (Column);
 778             end if;
 779
 780             Write_Line (S (First .. Last));
 781
 782             --  Set the beginning of the new remainder
 783
 784             First := Last + 1;
 785          end loop;
 786
 787          --  What is left goes to the buffer, without EOL
 788
 789          Write_Str (S (First .. S'Last));
 790       end if;
 791    end Write_Str;
 792 end Prj.Util;