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-2010, 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 := "";
 114       Include_Suffix : Boolean := True) return File_Name_Type
 115    is
 116       pragma Assert (Project /= No_Project);
 117
 118       The_Packages : constant Package_Id := Project.Decl.Packages;
 119
 120       Builder_Package : constant Prj.Package_Id :=
 121                           Prj.Util.Value_Of
 122                             (Name        => Name_Builder,
 123                              In_Packages => The_Packages,
 124                              In_Tree     => In_Tree);
 125
 126       Executable : Variable_Value :=
 127                      Prj.Util.Value_Of
 128                        (Name                    => Name_Id (Main),
 129                         Index                   => Index,
 130                         Attribute_Or_Array_Name => Name_Executable,
 131                         In_Package              => Builder_Package,
 132                         In_Tree                 => In_Tree);
 133
 134       Lang   : Language_Ptr;
 135
 136       Spec_Suffix : Name_Id := No_Name;
 137       Body_Suffix : Name_Id := No_Name;
 138
 139       Spec_Suffix_Length : Natural := 0;
 140       Body_Suffix_Length : Natural := 0;
 141
 142       procedure Get_Suffixes
 143         (B_Suffix : File_Name_Type;
 144          S_Suffix : File_Name_Type);
 145       --  Get the non empty suffixes in variables Spec_Suffix and Body_Suffix
 146
 147       function Add_Suffix (File : File_Name_Type) return File_Name_Type;
 148       --  Return the name of the executable, based on File, and adding the
 149       --  executable suffix if needed
 150
 151       ------------------
 152       -- Get_Suffixes --
 153       ------------------
 154
 155       procedure Get_Suffixes
 156         (B_Suffix : File_Name_Type;
 157          S_Suffix : File_Name_Type)
 158       is
 159       begin
 160          if B_Suffix /= No_File then
 161             Body_Suffix := Name_Id (B_Suffix);
 162             Body_Suffix_Length := Natural (Length_Of_Name (Body_Suffix));
 163          end if;
 164
 165          if S_Suffix /= No_File then
 166             Spec_Suffix := Name_Id (S_Suffix);
 167             Spec_Suffix_Length := Natural (Length_Of_Name (Spec_Suffix));
 168          end if;
 169       end Get_Suffixes;
 170
 171       ----------------
 172       -- Add_Suffix --
 173       ----------------
 174
 175       function Add_Suffix (File : File_Name_Type) return File_Name_Type is
 176          Saved_EEOT : constant Name_Id := Executable_Extension_On_Target;
 177          Result     : File_Name_Type;
 178          Suffix_From_Project : Variable_Value;
 179       begin
 180          if Include_Suffix then
 181             if Project.Config.Executable_Suffix /= No_Name then
 182                Executable_Extension_On_Target :=
 183                  Project.Config.Executable_Suffix;
 184             end if;
 185
 186             Result :=  Executable_Name (File);
 187             Executable_Extension_On_Target := Saved_EEOT;
 188             return Result;
 189
 190          else
 191             --  We still want to take into account cases where the suffix is
 192             --  specified in the project itself, as opposed to the config file.
 193             --  Unfortunately, when the project was processed, they are both
 194             --  stored in Project.Config, so we need to get it from the project
 195             --  again
 196
 197             Suffix_From_Project :=
 198               Prj.Util.Value_Of
 199                 (Variable_Name => Name_Executable_Suffix,
 200                  In_Variables  =>
 201                    In_Tree.Packages.Table (Builder_Package).Decl.Attributes,
 202                  In_Tree       => In_Tree);
 203
 204             if Suffix_From_Project /= Nil_Variable_Value
 205               and then Suffix_From_Project.Value /= No_Name
 206             then
 207                Executable_Extension_On_Target := Suffix_From_Project.Value;
 208                Result :=  Executable_Name (File);
 209                Executable_Extension_On_Target := Saved_EEOT;
 210                return Result;
 211
 212             else
 213                return File;
 214             end if;
 215          end if;
 216       end Add_Suffix;
 217
 218    --  Start of processing for Executable_Of
 219
 220    begin
 221       if Ada_Main then
 222          Lang := Get_Language_From_Name (Project, "ada");
 223       elsif Language /= "" then
 224          Lang := Get_Language_From_Name (Project, Language);
 225       end if;
 226
 227       if Lang /= null then
 228          Get_Suffixes
 229            (B_Suffix => Lang.Config.Naming_Data.Body_Suffix,
 230             S_Suffix => Lang.Config.Naming_Data.Spec_Suffix);
 231       end if;
 232
 233       if Builder_Package /= No_Package then
 234          if Executable = Nil_Variable_Value and then Ada_Main then
 235             Get_Name_String (Main);
 236
 237             --  Try as index the name minus the implementation suffix or minus
 238             --  the specification suffix.
 239
 240             declare
 241                Name : constant String (1 .. Name_Len) :=
 242                         Name_Buffer (1 .. Name_Len);
 243                Last : Positive := Name_Len;
 244
 245                Truncated : Boolean := False;
 246
 247             begin
 248                if Body_Suffix /= No_Name
 249                  and then Last > Natural (Length_Of_Name (Body_Suffix))
 250                  and then Name (Last - Body_Suffix_Length + 1 .. Last) =
 251                             Get_Name_String (Body_Suffix)
 252                then
 253                   Truncated := True;
 254                   Last := Last - Body_Suffix_Length;
 255                end if;
 256
 257                if Spec_Suffix /= No_Name
 258                  and then not Truncated
 259                  and then Last > Spec_Suffix_Length
 260                  and then Name (Last - Spec_Suffix_Length + 1 .. Last) =
 261                             Get_Name_String (Spec_Suffix)
 262                then
 263                   Truncated := True;
 264                   Last := Last - Spec_Suffix_Length;
 265                end if;
 266
 267                if Truncated then
 268                   Name_Len := Last;
 269                   Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
 270                   Executable :=
 271                     Prj.Util.Value_Of
 272                       (Name                    => Name_Find,
 273                        Index                   => 0,
 274                        Attribute_Or_Array_Name => Name_Executable,
 275                        In_Package              => Builder_Package,
 276                        In_Tree                 => In_Tree);
 277                end if;
 278             end;
 279          end if;
 280
 281          --  If we have found an Executable attribute, return its value,
 282          --  possibly suffixed by the executable suffix.
 283
 284          if Executable /= Nil_Variable_Value
 285            and then Executable.Value /= No_Name
 286            and then Length_Of_Name (Executable.Value) /= 0
 287          then
 288             return Add_Suffix (File_Name_Type (Executable.Value));
 289          end if;
 290       end if;
 291
 292       Get_Name_String (Main);
 293
 294       --  If there is a body suffix or a spec suffix, remove this suffix,
 295       --  otherwise remove any suffix ('.' followed by other characters), if
 296       --  there is one.
 297
 298       if Body_Suffix /= No_Name
 299          and then Name_Len > Body_Suffix_Length
 300          and then Name_Buffer (Name_Len - Body_Suffix_Length + 1 .. Name_Len) =
 301                     Get_Name_String (Body_Suffix)
 302       then
 303          --  Found the body termination, remove it
 304
 305          Name_Len := Name_Len - Body_Suffix_Length;
 306
 307       elsif Spec_Suffix /= No_Name
 308             and then Name_Len > Spec_Suffix_Length
 309             and then
 310               Name_Buffer (Name_Len - Spec_Suffix_Length + 1 .. Name_Len) =
 311                 Get_Name_String (Spec_Suffix)
 312       then
 313          --  Found the spec termination, remove it
 314
 315          Name_Len := Name_Len - Spec_Suffix_Length;
 316
 317       else
 318          --  Remove any suffix, if there is one
 319
 320          Get_Name_String (Strip_Suffix (Main));
 321       end if;
 322
 323       return Add_Suffix (Name_Find);
 324    end Executable_Of;
 325
 326    --------------
 327    -- Get_Line --
 328    --------------
 329
 330    procedure Get_Line
 331      (File : Text_File;
 332       Line : out String;
 333       Last : out Natural)
 334    is
 335       C : Character;
 336
 337       procedure Advance;
 338
 339       -------------
 340       -- Advance --
 341       -------------
 342
 343       procedure Advance is
 344       begin
 345          if File.Cursor = File.Buffer_Len then
 346             File.Buffer_Len :=
 347               Read
 348                (FD => File.FD,
 349                 A  => File.Buffer'Address,
 350                 N  => File.Buffer'Length);
 351
 352             if File.Buffer_Len = 0 then
 353                File.End_Of_File_Reached := True;
 354                return;
 355             else
 356                File.Cursor := 1;
 357             end if;
 358
 359          else
 360             File.Cursor := File.Cursor + 1;
 361          end if;
 362       end Advance;
 363
 364    --  Start of processing for Get_Line
 365
 366    begin
 367       if File = null then
 368          Prj.Com.Fail ("Get_Line attempted on an invalid Text_File");
 369       end if;
 370
 371       Last := Line'First - 1;
 372
 373       if not File.End_Of_File_Reached then
 374          loop
 375             C := File.Buffer (File.Cursor);
 376             exit when C = ASCII.CR or else C = ASCII.LF;
 377             Last := Last + 1;
 378             Line (Last) := C;
 379             Advance;
 380
 381             if File.End_Of_File_Reached then
 382                return;
 383             end if;
 384
 385             exit when Last = Line'Last;
 386          end loop;
 387
 388          if C = ASCII.CR or else C = ASCII.LF then
 389             Advance;
 390
 391             if File.End_Of_File_Reached then
 392                return;
 393             end if;
 394          end if;
 395
 396          if C = ASCII.CR
 397            and then File.Buffer (File.Cursor) = ASCII.LF
 398          then
 399             Advance;
 400          end if;
 401       end if;
 402    end Get_Line;
 403
 404    --------------
 405    -- Is_Valid --
 406    --------------
 407
 408    function Is_Valid (File : Text_File) return Boolean is
 409    begin
 410       return File /= null;
 411    end Is_Valid;
 412
 413    ----------
 414    -- Open --
 415    ----------
 416
 417    procedure Open (File : out Text_File; Name : String) is
 418       FD        : File_Descriptor;
 419       File_Name : String (1 .. Name'Length + 1);
 420
 421    begin
 422       File_Name (1 .. Name'Length) := Name;
 423       File_Name (File_Name'Last) := ASCII.NUL;
 424       FD := Open_Read (Name => File_Name'Address,
 425                        Fmode => GNAT.OS_Lib.Text);
 426
 427       if FD = Invalid_FD then
 428          File := null;
 429
 430       else
 431          File := new Text_File_Data;
 432          File.FD := FD;
 433          File.Buffer_Len :=
 434            Read (FD => FD,
 435                  A  => File.Buffer'Address,
 436                  N  => File.Buffer'Length);
 437
 438          if File.Buffer_Len = 0 then
 439             File.End_Of_File_Reached := True;
 440          else
 441             File.Cursor := 1;
 442          end if;
 443       end if;
 444    end Open;
 445
 446    ---------
 447    -- Put --
 448    ---------
 449
 450    procedure Put
 451      (Into_List  : in out Name_List_Index;
 452       From_List  : String_List_Id;
 453       In_Tree    : Project_Tree_Ref;
 454       Lower_Case : Boolean := False)
 455    is
 456       Current_Name : Name_List_Index;
 457       List         : String_List_Id;
 458       Element      : String_Element;
 459       Last         : Name_List_Index :=
 460                        Name_List_Table.Last (In_Tree.Name_Lists);
 461       Value        : Name_Id;
 462
 463    begin
 464       Current_Name := Into_List;
 465       while Current_Name /= No_Name_List
 466         and then In_Tree.Name_Lists.Table (Current_Name).Next /= No_Name_List
 467       loop
 468          Current_Name := In_Tree.Name_Lists.Table (Current_Name).Next;
 469       end loop;
 470
 471       List := From_List;
 472       while List /= Nil_String loop
 473          Element := In_Tree.String_Elements.Table (List);
 474          Value := Element.Value;
 475
 476          if Lower_Case then
 477             Get_Name_String (Value);
 478             To_Lower (Name_Buffer (1 .. Name_Len));
 479             Value := Name_Find;
 480          end if;
 481
 482          Name_List_Table.Append
 483            (In_Tree.Name_Lists, (Name => Value, Next => No_Name_List));
 484
 485          Last := Last + 1;
 486
 487          if Current_Name = No_Name_List then
 488             Into_List := Last;
 489
 490          else
 491             In_Tree.Name_Lists.Table (Current_Name).Next := Last;
 492          end if;
 493
 494          Current_Name := Last;
 495
 496          List := Element.Next;
 497       end loop;
 498    end Put;
 499
 500    --------------
 501    -- Value_Of --
 502    --------------
 503
 504    function Value_Of
 505      (Variable : Variable_Value;
 506       Default  : String) return String
 507    is
 508    begin
 509       if Variable.Kind /= Single
 510         or else Variable.Default
 511         or else Variable.Value = No_Name
 512       then
 513          return Default;
 514       else
 515          return Get_Name_String (Variable.Value);
 516       end if;
 517    end Value_Of;
 518
 519    function Value_Of
 520      (Index    : Name_Id;
 521       In_Array : Array_Element_Id;
 522       In_Tree  : Project_Tree_Ref) return Name_Id
 523    is
 524       Current    : Array_Element_Id;
 525       Element    : Array_Element;
 526       Real_Index : Name_Id := Index;
 527
 528    begin
 529       Current := In_Array;
 530
 531       if Current = No_Array_Element then
 532          return No_Name;
 533       end if;
 534
 535       Element := In_Tree.Array_Elements.Table (Current);
 536
 537       if not Element.Index_Case_Sensitive then
 538          Get_Name_String (Index);
 539          To_Lower (Name_Buffer (1 .. Name_Len));
 540          Real_Index := Name_Find;
 541       end if;
 542
 543       while Current /= No_Array_Element loop
 544          Element := In_Tree.Array_Elements.Table (Current);
 545
 546          if Real_Index = Element.Index then
 547             exit when Element.Value.Kind /= Single;
 548             exit when Element.Value.Value = Empty_String;
 549             return Element.Value.Value;
 550          else
 551             Current := Element.Next;
 552          end if;
 553       end loop;
 554
 555       return No_Name;
 556    end Value_Of;
 557
 558    function Value_Of
 559      (Index                  : Name_Id;
 560       Src_Index              : Int := 0;
 561       In_Array               : Array_Element_Id;
 562       In_Tree                : Project_Tree_Ref;
 563       Force_Lower_Case_Index : Boolean := False) return Variable_Value
 564    is
 565       Current      : Array_Element_Id;
 566       Element      : Array_Element;
 567       Real_Index_1 : Name_Id;
 568       Real_Index_2 : Name_Id;
 569
 570    begin
 571       Current := In_Array;
 572
 573       if Current = No_Array_Element then
 574          return Nil_Variable_Value;
 575       end if;
 576
 577       Element := In_Tree.Array_Elements.Table (Current);
 578
 579       Real_Index_1 := Index;
 580
 581       if not Element.Index_Case_Sensitive or else Force_Lower_Case_Index then
 582          if Index /= All_Other_Names then
 583             Get_Name_String (Index);
 584             To_Lower (Name_Buffer (1 .. Name_Len));
 585             Real_Index_1 := Name_Find;
 586          end if;
 587       end if;
 588
 589       while Current /= No_Array_Element loop
 590          Element := In_Tree.Array_Elements.Table (Current);
 591          Real_Index_2 := Element.Index;
 592
 593          if not Element.Index_Case_Sensitive
 594            or else Force_Lower_Case_Index
 595          then
 596             if Element.Index /= All_Other_Names then
 597                Get_Name_String (Element.Index);
 598                To_Lower (Name_Buffer (1 .. Name_Len));
 599                Real_Index_2 := Name_Find;
 600             end if;
 601          end if;
 602
 603          if Real_Index_1 = Real_Index_2 and then
 604            Src_Index = Element.Src_Index
 605          then
 606             return Element.Value;
 607          else
 608             Current := Element.Next;
 609          end if;
 610       end loop;
 611
 612       return Nil_Variable_Value;
 613    end Value_Of;
 614
 615    function Value_Of
 616      (Name                    : Name_Id;
 617       Index                   : Int := 0;
 618       Attribute_Or_Array_Name : Name_Id;
 619       In_Package              : Package_Id;
 620       In_Tree                 : Project_Tree_Ref;
 621       Force_Lower_Case_Index  : Boolean := False) return Variable_Value
 622    is
 623       The_Array     : Array_Element_Id;
 624       The_Attribute : Variable_Value := Nil_Variable_Value;
 625
 626    begin
 627       if In_Package /= No_Package then
 628
 629          --  First, look if there is an array element that fits
 630
 631          The_Array :=
 632            Value_Of
 633              (Name      => Attribute_Or_Array_Name,
 634               In_Arrays => In_Tree.Packages.Table (In_Package).Decl.Arrays,
 635               In_Tree   => In_Tree);
 636          The_Attribute :=
 637            Value_Of
 638              (Index                  => Name,
 639               Src_Index              => Index,
 640               In_Array               => The_Array,
 641               In_Tree                => In_Tree,
 642               Force_Lower_Case_Index => Force_Lower_Case_Index);
 643
 644          --  If there is no array element, look for a variable
 645
 646          if The_Attribute = Nil_Variable_Value then
 647             The_Attribute :=
 648               Value_Of
 649                 (Variable_Name => Attribute_Or_Array_Name,
 650                  In_Variables  => In_Tree.Packages.Table
 651                                     (In_Package).Decl.Attributes,
 652                  In_Tree       => In_Tree);
 653          end if;
 654       end if;
 655
 656       return The_Attribute;
 657    end Value_Of;
 658
 659    function Value_Of
 660      (Index     : Name_Id;
 661       In_Array  : Name_Id;
 662       In_Arrays : Array_Id;
 663       In_Tree   : Project_Tree_Ref) return Name_Id
 664    is
 665       Current   : Array_Id;
 666       The_Array : Array_Data;
 667
 668    begin
 669       Current := In_Arrays;
 670       while Current /= No_Array loop
 671          The_Array := In_Tree.Arrays.Table (Current);
 672          if The_Array.Name = In_Array then
 673             return Value_Of
 674               (Index, In_Array => The_Array.Value, In_Tree => In_Tree);
 675          else
 676             Current := The_Array.Next;
 677          end if;
 678       end loop;
 679
 680       return No_Name;
 681    end Value_Of;
 682
 683    function Value_Of
 684      (Name      : Name_Id;
 685       In_Arrays : Array_Id;
 686       In_Tree   : Project_Tree_Ref) return Array_Element_Id
 687    is
 688       Current   : Array_Id;
 689       The_Array : Array_Data;
 690
 691    begin
 692       Current := In_Arrays;
 693       while Current /= No_Array loop
 694          The_Array := In_Tree.Arrays.Table (Current);
 695
 696          if The_Array.Name = Name then
 697             return The_Array.Value;
 698          else
 699             Current := The_Array.Next;
 700          end if;
 701       end loop;
 702
 703       return No_Array_Element;
 704    end Value_Of;
 705
 706    function Value_Of
 707      (Name        : Name_Id;
 708       In_Packages : Package_Id;
 709       In_Tree     : Project_Tree_Ref) return Package_Id
 710    is
 711       Current     : Package_Id;
 712       The_Package : Package_Element;
 713
 714    begin
 715       Current := In_Packages;
 716       while Current /= No_Package loop
 717          The_Package := In_Tree.Packages.Table (Current);
 718          exit when The_Package.Name /= No_Name
 719            and then The_Package.Name = Name;
 720          Current := The_Package.Next;
 721       end loop;
 722
 723       return Current;
 724    end Value_Of;
 725
 726    function Value_Of
 727      (Variable_Name : Name_Id;
 728       In_Variables  : Variable_Id;
 729       In_Tree       : Project_Tree_Ref) return Variable_Value
 730    is
 731       Current      : Variable_Id;
 732       The_Variable : Variable;
 733
 734    begin
 735       Current := In_Variables;
 736       while Current /= No_Variable loop
 737          The_Variable :=
 738            In_Tree.Variable_Elements.Table (Current);
 739
 740          if Variable_Name = The_Variable.Name then
 741             return The_Variable.Value;
 742          else
 743             Current := The_Variable.Next;
 744          end if;
 745       end loop;
 746
 747       return Nil_Variable_Value;
 748    end Value_Of;
 749
 750    ---------------
 751    -- Write_Str --
 752    ---------------
 753
 754    procedure Write_Str
 755      (S          : String;
 756       Max_Length : Positive;
 757       Separator  : Character)
 758    is
 759       First : Positive := S'First;
 760       Last  : Natural  := S'Last;
 761
 762    begin
 763       --  Nothing to do for empty strings
 764
 765       if S'Length > 0 then
 766
 767          --  Start on a new line if current line is already longer than
 768          --  Max_Length.
 769
 770          if Positive (Column) >= Max_Length then
 771             Write_Eol;
 772          end if;
 773
 774          --  If length of remainder is longer than Max_Length, we need to
 775          --  cut the remainder in several lines.
 776
 777          while Positive (Column) + S'Last - First > Max_Length loop
 778
 779             --  Try the maximum length possible
 780
 781             Last := First + Max_Length - Positive (Column);
 782
 783             --  Look for last Separator in the line
 784
 785             while Last >= First and then S (Last) /= Separator loop
 786                Last := Last - 1;
 787             end loop;
 788
 789             --  If we do not find a separator, we output the maximum length
 790             --  possible.
 791
 792             if Last < First then
 793                Last := First + Max_Length - Positive (Column);
 794             end if;
 795
 796             Write_Line (S (First .. Last));
 797
 798             --  Set the beginning of the new remainder
 799
 800             First := Last + 1;
 801          end loop;
 802
 803          --  What is left goes to the buffer, without EOL
 804
 805          Write_Str (S (First .. S'Last));
 806       end if;
 807    end Write_Str;
 808 end Prj.Util;