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