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-2008, 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 :=
 118                        In_Tree.Projects.Table (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       Executable_Suffix : Variable_Value := Nil_Variable_Value;
 135
 136       Executable_Suffix_Name : Name_Id := No_Name;
 137
 138       Naming : constant Naming_Data := In_Tree.Projects.Table (Project).Naming;
 139
 140       Spec_Suffix : Name_Id := No_Name;
 141       Body_Suffix : Name_Id := No_Name;
 142
 143       Spec_Suffix_Length : Natural := 0;
 144       Body_Suffix_Length : Natural := 0;
 145
 146       procedure Get_Suffixes
 147         (B_Suffix : String;
 148          S_Suffix : String);
 149       --  Get the non empty suffixes in variables Spec_Suffix and Body_Suffix
 150
 151       ------------------
 152       -- Get_Suffixes --
 153       ------------------
 154
 155       procedure Get_Suffixes
 156         (B_Suffix : String;
 157          S_Suffix : String)
 158       is
 159       begin
 160          if B_Suffix'Length > 0 then
 161             Name_Len := B_Suffix'Length;
 162             Name_Buffer (1 .. Name_Len) := B_Suffix;
 163             Body_Suffix := Name_Find;
 164             Body_Suffix_Length := B_Suffix'Length;
 165          end if;
 166
 167          if S_Suffix'Length > 0 then
 168             Name_Len := S_Suffix'Length;
 169             Name_Buffer (1 .. Name_Len) := S_Suffix;
 170             Spec_Suffix := Name_Find;
 171             Spec_Suffix_Length := S_Suffix'Length;
 172          end if;
 173       end Get_Suffixes;
 174
 175    --  Start of processing for Executable_Of
 176
 177    begin
 178       if Ada_Main then
 179          Get_Suffixes
 180            (B_Suffix => Body_Suffix_Of (In_Tree, "ada", Naming),
 181             S_Suffix => Spec_Suffix_Of (In_Tree, "ada", Naming));
 182
 183       elsif Language /= "" then
 184          Get_Suffixes
 185            (B_Suffix => Body_Suffix_Of (In_Tree, Language, Naming),
 186             S_Suffix => Spec_Suffix_Of (In_Tree, Language, Naming));
 187       end if;
 188
 189       if Builder_Package /= No_Package then
 190          if Get_Mode = Multi_Language then
 191             Executable_Suffix_Name :=
 192               In_Tree.Projects.Table (Project).Config.Executable_Suffix;
 193
 194          else
 195             Executable_Suffix := Prj.Util.Value_Of
 196               (Variable_Name => Name_Executable_Suffix,
 197                In_Variables  => In_Tree.Packages.Table
 198                  (Builder_Package).Decl.Attributes,
 199                In_Tree       => In_Tree);
 200
 201             if Executable_Suffix /= Nil_Variable_Value
 202               and then not Executable_Suffix.Default
 203             then
 204                Executable_Suffix_Name := Executable_Suffix.Value;
 205             end if;
 206          end if;
 207
 208          if Executable = Nil_Variable_Value and Ada_Main then
 209             Get_Name_String (Main);
 210
 211             --  Try as index the name minus the implementation suffix or minus
 212             --  the specification suffix.
 213
 214             declare
 215                Name : constant String (1 .. Name_Len) :=
 216                         Name_Buffer (1 .. Name_Len);
 217                Last : Positive := Name_Len;
 218
 219                Truncated : Boolean := False;
 220
 221             begin
 222                if Last > Natural (Length_Of_Name (Body_Suffix))
 223                  and then Name (Last - Body_Suffix_Length + 1 .. Last) =
 224                             Get_Name_String (Body_Suffix)
 225                then
 226                   Truncated := True;
 227                   Last := Last - Body_Suffix_Length;
 228                end if;
 229
 230                if not Truncated
 231                  and then Last > Spec_Suffix_Length
 232                  and then Name (Last - Spec_Suffix_Length + 1 .. Last) =
 233                             Get_Name_String (Spec_Suffix)
 234                then
 235                   Truncated := True;
 236                   Last := Last - Spec_Suffix_Length;
 237                end if;
 238
 239                if Truncated then
 240                   Name_Len := Last;
 241                   Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
 242                   Executable :=
 243                     Prj.Util.Value_Of
 244                       (Name                    => Name_Find,
 245                        Index                   => 0,
 246                        Attribute_Or_Array_Name => Name_Executable,
 247                        In_Package              => Builder_Package,
 248                        In_Tree                 => In_Tree);
 249                end if;
 250             end;
 251          end if;
 252
 253          --  If we have found an Executable attribute, return its value,
 254          --  possibly suffixed by the executable suffix.
 255
 256          if Executable /= Nil_Variable_Value
 257            and then Executable.Value /= Empty_Name
 258          then
 259             --  Get the executable name. If Executable_Suffix is defined,
 260             --  make sure that it will be the extension of the executable.
 261
 262             declare
 263                Saved_EEOT : constant Name_Id := Executable_Extension_On_Target;
 264                Result     : File_Name_Type;
 265
 266             begin
 267                if Executable_Suffix_Name /= No_Name then
 268                   Executable_Extension_On_Target := Executable_Suffix_Name;
 269                end if;
 270
 271                Result :=  Executable_Name (File_Name_Type (Executable.Value));
 272                Executable_Extension_On_Target := Saved_EEOT;
 273                return Result;
 274             end;
 275          end if;
 276       end if;
 277
 278       Get_Name_String (Main);
 279
 280       --  If there is a body suffix or a spec suffix, remove this suffix,
 281       --  otherwise remove any suffix ('.' followed by other characters), if
 282       --  there is one.
 283
 284       if Body_Suffix /= No_Name
 285          and then Name_Len > Body_Suffix_Length
 286          and then Name_Buffer (Name_Len - Body_Suffix_Length + 1 .. Name_Len) =
 287                     Get_Name_String (Body_Suffix)
 288       then
 289          --  Found the body termination, remove it
 290
 291          Name_Len := Name_Len - Body_Suffix_Length;
 292
 293       elsif Spec_Suffix /= No_Name
 294             and then Name_Len > Spec_Suffix_Length
 295             and then
 296               Name_Buffer (Name_Len - Spec_Suffix_Length + 1 .. Name_Len) =
 297                 Get_Name_String (Spec_Suffix)
 298       then
 299          --  Found the spec termination, remove it
 300
 301          Name_Len := Name_Len - Spec_Suffix_Length;
 302
 303       else
 304          --  Remove any suffix, if there is one
 305
 306          Get_Name_String (Strip_Suffix (Main));
 307       end if;
 308
 309       if Executable_Suffix /= Nil_Variable_Value
 310         and then not Executable_Suffix.Default
 311       then
 312          --  If attribute Executable_Suffix is specified, add this suffix
 313
 314          declare
 315             Suffix : constant String :=
 316                        Get_Name_String (Executable_Suffix.Value);
 317          begin
 318             Name_Buffer (Name_Len + 1 .. Name_Len + Suffix'Length) := Suffix;
 319             Name_Len := Name_Len + Suffix'Length;
 320             return Name_Find;
 321          end;
 322
 323       else
 324          --  Get the executable name. If Executable_Suffix is defined in the
 325          --  configuration, make sure that it will be the extension of the
 326          --  executable.
 327
 328          declare
 329             Saved_EEOT : constant Name_Id := Executable_Extension_On_Target;
 330             Result     : File_Name_Type;
 331
 332          begin
 333             if In_Tree.Projects.Table (Project).Config.Executable_Suffix /=
 334               No_Name
 335             then
 336                Executable_Extension_On_Target :=
 337                  In_Tree.Projects.Table (Project).Config.Executable_Suffix;
 338             end if;
 339
 340             Result := Executable_Name (Name_Find);
 341             Executable_Extension_On_Target := Saved_EEOT;
 342             return Result;
 343          end;
 344       end if;
 345    end Executable_Of;
 346
 347    --------------
 348    -- Get_Line --
 349    --------------
 350
 351    procedure Get_Line
 352      (File : Text_File;
 353       Line : out String;
 354       Last : out Natural)
 355    is
 356       C : Character;
 357
 358       procedure Advance;
 359
 360       -------------
 361       -- Advance --
 362       -------------
 363
 364       procedure Advance is
 365       begin
 366          if File.Cursor = File.Buffer_Len then
 367             File.Buffer_Len :=
 368               Read
 369                (FD => File.FD,
 370                 A  => File.Buffer'Address,
 371                 N  => File.Buffer'Length);
 372
 373             if File.Buffer_Len = 0 then
 374                File.End_Of_File_Reached := True;
 375                return;
 376             else
 377                File.Cursor := 1;
 378             end if;
 379
 380          else
 381             File.Cursor := File.Cursor + 1;
 382          end if;
 383       end Advance;
 384
 385    --  Start of processing for Get_Line
 386
 387    begin
 388       if File = null then
 389          Prj.Com.Fail ("Get_Line attempted on an invalid Text_File");
 390       end if;
 391
 392       Last := Line'First - 1;
 393
 394       if not File.End_Of_File_Reached then
 395          loop
 396             C := File.Buffer (File.Cursor);
 397             exit when C = ASCII.CR or else C = ASCII.LF;
 398             Last := Last + 1;
 399             Line (Last) := C;
 400             Advance;
 401
 402             if File.End_Of_File_Reached then
 403                return;
 404             end if;
 405
 406             exit when Last = Line'Last;
 407          end loop;
 408
 409          if C = ASCII.CR or else C = ASCII.LF then
 410             Advance;
 411
 412             if File.End_Of_File_Reached then
 413                return;
 414             end if;
 415          end if;
 416
 417          if C = ASCII.CR
 418            and then File.Buffer (File.Cursor) = ASCII.LF
 419          then
 420             Advance;
 421          end if;
 422       end if;
 423    end Get_Line;
 424
 425    --------------
 426    -- Is_Valid --
 427    --------------
 428
 429    function Is_Valid (File : Text_File) return Boolean is
 430    begin
 431       return File /= null;
 432    end Is_Valid;
 433
 434    ----------
 435    -- Open --
 436    ----------
 437
 438    procedure Open (File : out Text_File; Name : String) is
 439       FD        : File_Descriptor;
 440       File_Name : String (1 .. Name'Length + 1);
 441
 442    begin
 443       File_Name (1 .. Name'Length) := Name;
 444       File_Name (File_Name'Last) := ASCII.NUL;
 445       FD := Open_Read (Name => File_Name'Address,
 446                        Fmode => GNAT.OS_Lib.Text);
 447
 448       if FD = Invalid_FD then
 449          File := null;
 450
 451       else
 452          File := new Text_File_Data;
 453          File.FD := FD;
 454          File.Buffer_Len :=
 455            Read (FD => FD,
 456                  A  => File.Buffer'Address,
 457                  N  => File.Buffer'Length);
 458
 459          if File.Buffer_Len = 0 then
 460             File.End_Of_File_Reached := True;
 461          else
 462             File.Cursor := 1;
 463          end if;
 464       end if;
 465    end Open;
 466
 467    ---------
 468    -- Put --
 469    ---------
 470
 471    procedure Put
 472      (Into_List  : in out Name_List_Index;
 473       From_List  : String_List_Id;
 474       In_Tree    : Project_Tree_Ref;
 475       Lower_Case : Boolean := False)
 476    is
 477       Current_Name : Name_List_Index;
 478       List         : String_List_Id;
 479       Element      : String_Element;
 480       Last         : Name_List_Index :=
 481                        Name_List_Table.Last (In_Tree.Name_Lists);
 482       Value        : Name_Id;
 483
 484    begin
 485       Current_Name := Into_List;
 486       while Current_Name /= No_Name_List
 487         and then In_Tree.Name_Lists.Table (Current_Name).Next /= No_Name_List
 488       loop
 489          Current_Name := In_Tree.Name_Lists.Table (Current_Name).Next;
 490       end loop;
 491
 492       List := From_List;
 493       while List /= Nil_String loop
 494          Element := In_Tree.String_Elements.Table (List);
 495          Value := Element.Value;
 496
 497          if Lower_Case then
 498             Get_Name_String (Value);
 499             To_Lower (Name_Buffer (1 .. Name_Len));
 500             Value := Name_Find;
 501          end if;
 502
 503          Name_List_Table.Append
 504            (In_Tree.Name_Lists, (Name => Value, Next => No_Name_List));
 505
 506          Last := Last + 1;
 507
 508          if Current_Name = No_Name_List then
 509             Into_List := Last;
 510
 511          else
 512             In_Tree.Name_Lists.Table (Current_Name).Next := Last;
 513          end if;
 514
 515          Current_Name := Last;
 516
 517          List := Element.Next;
 518       end loop;
 519    end Put;
 520
 521    --------------
 522    -- Value_Of --
 523    --------------
 524
 525    function Value_Of
 526      (Variable : Variable_Value;
 527       Default  : String) return String
 528    is
 529    begin
 530       if Variable.Kind /= Single
 531         or else Variable.Default
 532         or else Variable.Value = No_Name
 533       then
 534          return Default;
 535       else
 536          return Get_Name_String (Variable.Value);
 537       end if;
 538    end Value_Of;
 539
 540    function Value_Of
 541      (Index    : Name_Id;
 542       In_Array : Array_Element_Id;
 543       In_Tree  : Project_Tree_Ref) return Name_Id
 544    is
 545       Current    : Array_Element_Id;
 546       Element    : Array_Element;
 547       Real_Index : Name_Id := Index;
 548
 549    begin
 550       Current := In_Array;
 551
 552       if Current = No_Array_Element then
 553          return No_Name;
 554       end if;
 555
 556       Element := In_Tree.Array_Elements.Table (Current);
 557
 558       if not Element.Index_Case_Sensitive then
 559          Get_Name_String (Index);
 560          To_Lower (Name_Buffer (1 .. Name_Len));
 561          Real_Index := Name_Find;
 562       end if;
 563
 564       while Current /= No_Array_Element loop
 565          Element := In_Tree.Array_Elements.Table (Current);
 566
 567          if Real_Index = Element.Index then
 568             exit when Element.Value.Kind /= Single;
 569             exit when Element.Value.Value = Empty_String;
 570             return Element.Value.Value;
 571          else
 572             Current := Element.Next;
 573          end if;
 574       end loop;
 575
 576       return No_Name;
 577    end Value_Of;
 578
 579    function Value_Of
 580      (Index                  : Name_Id;
 581       Src_Index              : Int := 0;
 582       In_Array               : Array_Element_Id;
 583       In_Tree                : Project_Tree_Ref;
 584       Force_Lower_Case_Index : Boolean := False) return Variable_Value
 585    is
 586       Current      : Array_Element_Id;
 587       Element      : Array_Element;
 588       Real_Index_1 : Name_Id;
 589       Real_Index_2 : Name_Id;
 590
 591    begin
 592       Current := In_Array;
 593
 594       if Current = No_Array_Element then
 595          return Nil_Variable_Value;
 596       end if;
 597
 598       Element := In_Tree.Array_Elements.Table (Current);
 599
 600       Real_Index_1 := Index;
 601
 602       if not Element.Index_Case_Sensitive or Force_Lower_Case_Index then
 603          Get_Name_String (Index);
 604          To_Lower (Name_Buffer (1 .. Name_Len));
 605          Real_Index_1 := Name_Find;
 606       end if;
 607
 608       while Current /= No_Array_Element loop
 609          Element := In_Tree.Array_Elements.Table (Current);
 610          Real_Index_2 := Element.Index;
 611
 612          if not Element.Index_Case_Sensitive or Force_Lower_Case_Index then
 613             Get_Name_String (Element.Index);
 614             To_Lower (Name_Buffer (1 .. Name_Len));
 615             Real_Index_2 := Name_Find;
 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;