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 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 2,  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 COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Ada.Unchecked_Deallocation;
  28
  29 with Namet;    use Namet;
  30 with Osint;
  31 with Output;   use Output;
  32 with Stringt;  use Stringt;
  33
  34 package body Prj.Util is
  35
  36    procedure Free is new Ada.Unchecked_Deallocation
  37      (Text_File_Data, Text_File);
  38
  39    -----------
  40    -- Close --
  41    -----------
  42
  43    procedure Close (File : in out Text_File) is
  44    begin
  45       if File = null then
  46          Osint.Fail ("Close attempted on an invalid Text_File");
  47       end if;
  48
  49       Close (File.FD);
  50       Free (File);
  51    end Close;
  52
  53    -----------------
  54    -- End_Of_File --
  55    -----------------
  56
  57    function End_Of_File (File : Text_File) return Boolean is
  58    begin
  59       if File = null then
  60          Osint.Fail ("End_Of_File attempted on an invalid Text_File");
  61       end if;
  62
  63       return File.End_Of_File_Reached;
  64    end End_Of_File;
  65
  66    --------------
  67    -- Get_Line --
  68    --------------
  69
  70    procedure Get_Line
  71      (File : Text_File;
  72       Line : out String;
  73       Last : out Natural)
  74    is
  75       C : Character;
  76
  77       procedure Advance;
  78
  79       -------------
  80       -- Advance --
  81       -------------
  82
  83       procedure Advance is
  84       begin
  85          if File.Cursor = File.Buffer_Len then
  86             File.Buffer_Len :=
  87               Read
  88                (FD => File.FD,
  89                 A  => File.Buffer'Address,
  90                 N  => File.Buffer'Length);
  91
  92             if File.Buffer_Len = 0 then
  93                File.End_Of_File_Reached := True;
  94                return;
  95             else
  96                File.Cursor := 1;
  97             end if;
  98
  99          else
 100             File.Cursor := File.Cursor + 1;
 101          end if;
 102       end Advance;
 103
 104    --  Start of processing for Get_Line
 105
 106    begin
 107       if File = null then
 108          Osint.Fail ("Get_Line attempted on an invalid Text_File");
 109       end if;
 110
 111       Last := Line'First - 1;
 112
 113       if not File.End_Of_File_Reached then
 114          loop
 115             C := File.Buffer (File.Cursor);
 116             exit when C = ASCII.CR or else C = ASCII.LF;
 117             Last := Last + 1;
 118             Line (Last) := C;
 119             Advance;
 120
 121             if File.End_Of_File_Reached then
 122                return;
 123             end if;
 124
 125             exit when Last = Line'Last;
 126          end loop;
 127
 128          if C = ASCII.CR or else C = ASCII.LF then
 129             Advance;
 130
 131             if File.End_Of_File_Reached then
 132                return;
 133             end if;
 134          end if;
 135
 136          if C = ASCII.CR
 137            and then File.Buffer (File.Cursor) = ASCII.LF
 138          then
 139             Advance;
 140          end if;
 141       end if;
 142    end Get_Line;
 143
 144    --------------
 145    -- Is_Valid --
 146    --------------
 147
 148    function Is_Valid (File : Text_File) return Boolean is
 149    begin
 150       return File /= null;
 151    end Is_Valid;
 152
 153    ----------
 154    -- Open --
 155    ----------
 156
 157    procedure Open (File : out Text_File; Name : in String) is
 158       FD        : File_Descriptor;
 159       File_Name : String (1 .. Name'Length + 1);
 160
 161    begin
 162       File_Name (1 .. Name'Length) := Name;
 163       File_Name (File_Name'Last) := ASCII.NUL;
 164       FD := Open_Read (Name => File_Name'Address,
 165                             Fmode => GNAT.OS_Lib.Text);
 166       if FD = Invalid_FD then
 167          File := null;
 168       else
 169          File := new Text_File_Data;
 170          File.FD := FD;
 171          File.Buffer_Len :=
 172            Read (FD => FD,
 173                  A  => File.Buffer'Address,
 174                  N  => File.Buffer'Length);
 175
 176          if File.Buffer_Len = 0 then
 177             File.End_Of_File_Reached := True;
 178          else
 179             File.Cursor := 1;
 180          end if;
 181       end if;
 182    end Open;
 183
 184    --------------
 185    -- Value_Of --
 186    --------------
 187
 188    function Value_Of
 189      (Variable : Variable_Value;
 190       Default  : String)
 191       return     String
 192    is
 193    begin
 194       if Variable.Kind /= Single
 195         or else Variable.Default
 196         or else Variable.Value = No_String then
 197          return Default;
 198
 199       else
 200          String_To_Name_Buffer (Variable.Value);
 201          return Name_Buffer (1 .. Name_Len);
 202       end if;
 203    end Value_Of;
 204
 205    function Value_Of
 206      (Index    : Name_Id;
 207       In_Array : Array_Element_Id)
 208       return     Name_Id
 209    is
 210       Current : Array_Element_Id := In_Array;
 211       Element : Array_Element;
 212
 213    begin
 214       while Current /= No_Array_Element loop
 215          Element := Array_Elements.Table (Current);
 216
 217          if Index = Element.Index then
 218             exit when Element.Value.Kind /= Single;
 219             exit when String_Length (Element.Value.Value) = 0;
 220             String_To_Name_Buffer (Element.Value.Value);
 221             return Name_Find;
 222          else
 223             Current := Element.Next;
 224          end if;
 225       end loop;
 226
 227       return No_Name;
 228    end Value_Of;
 229
 230    function Value_Of
 231      (Index    : Name_Id;
 232       In_Array : Array_Element_Id)
 233       return     Variable_Value
 234    is
 235       Current : Array_Element_Id := In_Array;
 236       Element : Array_Element;
 237
 238    begin
 239       while Current /= No_Array_Element loop
 240          Element := Array_Elements.Table (Current);
 241
 242          if Index = Element.Index then
 243             return Element.Value;
 244          else
 245             Current := Element.Next;
 246          end if;
 247       end loop;
 248
 249       return Nil_Variable_Value;
 250    end Value_Of;
 251
 252    function Value_Of
 253      (Name                    : Name_Id;
 254       Attribute_Or_Array_Name : Name_Id;
 255       In_Package              : Package_Id)
 256       return                    Variable_Value
 257    is
 258       The_Array     : Array_Element_Id;
 259       The_Attribute : Variable_Value := Nil_Variable_Value;
 260
 261    begin
 262       if In_Package /= No_Package then
 263
 264          --  First, look if there is an array element that fits
 265
 266          The_Array :=
 267            Value_Of
 268              (Name      => Attribute_Or_Array_Name,
 269               In_Arrays => Packages.Table (In_Package).Decl.Arrays);
 270          The_Attribute :=
 271            Value_Of
 272              (Index    => Name,
 273               In_Array => The_Array);
 274
 275          --  If there is no array element, look for a variable
 276
 277          if The_Attribute = Nil_Variable_Value then
 278             The_Attribute :=
 279               Value_Of
 280                 (Variable_Name => Attribute_Or_Array_Name,
 281                  In_Variables  => Packages.Table (In_Package).Decl.Attributes);
 282          end if;
 283       end if;
 284
 285       return The_Attribute;
 286    end Value_Of;
 287
 288    function Value_Of
 289      (Index     : Name_Id;
 290       In_Array  : Name_Id;
 291       In_Arrays : Array_Id)
 292       return      Name_Id
 293    is
 294       Current : Array_Id := In_Arrays;
 295       The_Array : Array_Data;
 296
 297    begin
 298       while Current /= No_Array loop
 299          The_Array := Arrays.Table (Current);
 300          if The_Array.Name = In_Array then
 301             return Value_Of (Index, In_Array => The_Array.Value);
 302          else
 303             Current := The_Array.Next;
 304          end if;
 305       end loop;
 306
 307       return No_Name;
 308    end Value_Of;
 309
 310    function Value_Of
 311      (Name      : Name_Id;
 312       In_Arrays : Array_Id)
 313       return      Array_Element_Id
 314    is
 315       Current : Array_Id := In_Arrays;
 316       The_Array          : Array_Data;
 317
 318    begin
 319       while Current /= No_Array loop
 320          The_Array := Arrays.Table (Current);
 321
 322          if The_Array.Name = Name then
 323             return The_Array.Value;
 324          else
 325             Current := The_Array.Next;
 326          end if;
 327       end loop;
 328
 329       return No_Array_Element;
 330    end Value_Of;
 331
 332    function Value_Of
 333      (Name        : Name_Id;
 334       In_Packages : Package_Id)
 335       return        Package_Id
 336    is
 337       Current : Package_Id := In_Packages;
 338       The_Package : Package_Element;
 339
 340    begin
 341       while Current /= No_Package loop
 342          The_Package := Packages.Table (Current);
 343          exit when The_Package.Name /= No_Name
 344            and then The_Package.Name = Name;
 345          Current := The_Package.Next;
 346       end loop;
 347
 348       return Current;
 349    end Value_Of;
 350
 351    function Value_Of
 352      (Variable_Name : Name_Id;
 353       In_Variables  : Variable_Id)
 354       return          Variable_Value
 355    is
 356       Current : Variable_Id := In_Variables;
 357       The_Variable : Variable;
 358
 359    begin
 360       while Current /= No_Variable loop
 361          The_Variable := Variable_Elements.Table (Current);
 362
 363          if Variable_Name = The_Variable.Name then
 364             return The_Variable.Value;
 365          else
 366             Current := The_Variable.Next;
 367          end if;
 368       end loop;
 369
 370       return Nil_Variable_Value;
 371    end Value_Of;
 372
 373    ---------------
 374    -- Write_Str --
 375    ---------------
 376
 377    procedure Write_Str
 378      (S          : String;
 379       Max_Length : Positive;
 380       Separator  : Character)
 381    is
 382       First : Positive := S'First;
 383       Last  : Natural  := S'Last;
 384
 385    begin
 386       --  Nothing to do for empty strings
 387
 388       if S'Length > 0 then
 389
 390          --  Start on a new line if current line is already longer than
 391          --  Max_Length.
 392
 393          if Positive (Column) >= Max_Length then
 394             Write_Eol;
 395          end if;
 396
 397          --  If length of remainder is longer than Max_Length, we need to
 398          --  cut the remainder in several lines.
 399
 400          while Positive (Column) + S'Last - First > Max_Length loop
 401
 402             --  Try the maximum length possible
 403
 404             Last := First + Max_Length - Positive (Column);
 405
 406             --  Look for last Separator in the line
 407
 408             while Last >= First and then S (Last) /= Separator loop
 409                Last := Last - 1;
 410             end loop;
 411
 412             --  If we do not find a separator, we output the maximum length
 413             --  possible.
 414
 415             if Last < First then
 416                Last := First + Max_Length - Positive (Column);
 417             end if;
 418
 419             Write_Line (S (First .. Last));
 420
 421             --  Set the beginning of the new remainder
 422
 423             First := Last + 1;
 424          end loop;
 425
 426          --  What is left goes to the buffer, without EOL
 427
 428          Write_Str (S (First .. S'Last));
 429       end if;
 430    end Write_Str;
 431
 432 end Prj.Util;