gcc/ada/prj-attr.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P R J . A T T R                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2007, 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,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, 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 Osint;
  28 with Prj.Com; use Prj.Com;
  29 with System.Case_Util; use System.Case_Util;
  30
  31 package body Prj.Attr is
  32
  33    --  Data for predefined attributes and packages
  34
  35    --  Names are in lower case and end with '#'
  36
  37    --  Package names are preceded by 'P'
  38
  39    --  Attribute names are preceded by two or three letters:
  40
  41    --  The first letter is one of
  42    --    'S' for Single
  43    --    's' for Single with optional index
  44    --    'L' for List
  45    --    'l' for List of strings with optional indexes
  46
  47    --  The second letter is one of
  48    --    'V' for single variable
  49    --    'A' for associative array
  50    --    'a' for case insensitive associative array
  51    --    'b' for associative array, case insensitive if file names are case
  52    --        insensitive
  53    --    'c' same as 'b', with optional index
  54
  55    --  The third optional letter is
  56    --     'R' to indicate that the attribute is read-only
  57
  58    --  End is indicated by two consecutive '#'
  59
  60    Initialization_Data : constant String :=
  61
  62    --  project level attributes
  63
  64    --  General
  65
  66    "SVRname#" &
  67    "lVmain#" &
  68    "LVlanguages#" &
  69    "SVmain_language#" &
  70    "Laroots#" &
  71    "SVexternally_built#" &
  72
  73    --  Directories
  74
  75    "SVobject_dir#" &
  76    "SVexec_dir#" &
  77    "LVsource_dirs#" &
  78    "LVremoved_source_dirs#" &
  79
  80    --  Source files
  81
  82    "LVsource_files#" &
  83    "LVlocally_removed_files#" &
  84    "SVsource_list_file#" &
  85
  86    --  Libraries
  87
  88    "SVlibrary_dir#" &
  89    "SVlibrary_name#" &
  90    "SVlibrary_kind#" &
  91    "SVlibrary_version#" &
  92    "LVlibrary_interface#" &
  93    "SVlibrary_auto_init#" &
  94    "LVlibrary_options#" &
  95    "SVlibrary_src_dir#" &
  96    "SVlibrary_ali_dir#" &
  97    "SVlibrary_gcc#" &
  98    "SVlibrary_symbol_file#" &
  99    "SVlibrary_symbol_policy#" &
 100    "SVlibrary_reference_symbol_file#" &
 101
 102    --  Configuration - General
 103
 104    "SVdefault_language#" &
 105    "LVrun_path_option#" &
 106    "Satoolchain_version#" &
 107    "Satoolchain_description#" &
 108
 109    --  Configuration - Libraries
 110
 111    "SVlibrary_builder#" &
 112    "SVlibrary_support#" &
 113
 114    --  Configuration - Archives
 115
 116    "LVarchive_builder#" &
 117    "LVarchive_indexer#" &
 118    "SVarchive_suffix#" &
 119    "LVlibrary_partial_linker#" &
 120
 121    --  Configuration - Shared libraries
 122
 123    "SVshared_library_prefix#" &
 124    "SVshared_library_suffix#" &
 125    "SVsymbolic_link_supported#" &
 126    "SVlibrary_major_minor_id_supported#" &
 127    "SVlibrary_auto_init_supported#" &
 128    "LVshared_library_minimum_switches#" &
 129    "LVlibrary_version_switches#" &
 130
 131    --  package Naming
 132
 133    "Pnaming#" &
 134    "Saspecification_suffix#" &
 135    "Saspec_suffix#" &
 136    "Saimplementation_suffix#" &
 137    "Sabody_suffix#" &
 138    "SVseparate_suffix#" &
 139    "SVcasing#" &
 140    "SVdot_replacement#" &
 141    "sAspecification#" &
 142    "sAspec#" &
 143    "sAimplementation#" &
 144    "sAbody#" &
 145    "Laspecification_exceptions#" &
 146    "Laimplementation_exceptions#" &
 147
 148    --  package Compiler
 149
 150    "Pcompiler#" &
 151    "Ladefault_switches#" &
 152    "Lcswitches#" &
 153    "SVlocal_configuration_pragmas#" &
 154    "Salocal_config_file#" &
 155
 156    --  Configuration - Compiling
 157
 158    "Sadriver#" &
 159    "Lapic_option#" &
 160
 161    --  Configuration - Mapping files
 162
 163    "Lamapping_file_switches#" &
 164    "Samapping_spec_suffix#" &
 165    "Samapping_body_suffix#" &
 166
 167    --  Configuration - Config files
 168
 169    "Laconfig_file_switches#" &
 170    "Saconfig_body_file_name#" &
 171    "Saconfig_spec_file_name#" &
 172    "Saconfig_body_file_name_pattern#" &
 173    "Saconfig_spec_file_name_pattern#" &
 174    "Saconfig_file_unique#" &
 175
 176    --  Configuration - Dependencies
 177
 178    "Ladependency_switches#" &
 179    "Lacompute_dependency#" &
 180
 181    --  Configuration - Search paths
 182
 183    "Lainclude_switches#" &
 184    "Sainclude_path#" &
 185    "Sainclude_path_file#" &
 186
 187    --  package Builder
 188
 189    "Pbuilder#" &
 190    "Ladefault_switches#" &
 191    "Lcswitches#" &
 192    "Scexecutable#" &
 193    "SVexecutable_suffix#" &
 194    "SVglobal_configuration_pragmas#" &
 195    "Saglobal_config_file#" &
 196
 197    --  package gnatls
 198
 199    "Pgnatls#" &
 200    "LVswitches#" &
 201
 202    --  package Binder
 203
 204    "Pbinder#" &
 205    "Ladefault_switches#" &
 206    "Lcswitches#" &
 207
 208    --  Configuration - Binding
 209
 210    "Sadriver#" &
 211    "Saprefix#" &
 212    "Saobjects_path#" &
 213    "Saobjects_path_file#" &
 214
 215    --  package Linker
 216
 217    "Plinker#" &
 218    "LVrequired_switches#" &
 219    "Ladefault_switches#" &
 220    "Lcswitches#" &
 221    "LVlinker_options#" &
 222
 223    --  Configuration - Linking
 224
 225    "SVdriver#" &
 226    "LVexecutable_switch#" &
 227    "SVlib_dir_switch#" &
 228    "SVlib_name_switch#" &
 229
 230    --  package Cross_Reference
 231
 232    "Pcross_reference#" &
 233    "Ladefault_switches#" &
 234    "Lbswitches#" &
 235
 236    --  package Finder
 237
 238    "Pfinder#" &
 239    "Ladefault_switches#" &
 240    "Lbswitches#" &
 241
 242    --  package Pretty_Printer
 243
 244    "Ppretty_printer#" &
 245    "Ladefault_switches#" &
 246    "Lbswitches#" &
 247
 248    --  package gnatstub
 249
 250    "Pgnatstub#" &
 251    "Ladefault_switches#" &
 252    "Lbswitches#" &
 253
 254    --  package Check
 255
 256    "Pcheck#" &
 257    "Ladefault_switches#" &
 258    "Lbswitches#" &
 259
 260    --  package Eliminate
 261
 262    "Peliminate#" &
 263    "Ladefault_switches#" &
 264    "Lbswitches#" &
 265
 266    --  package Metrics
 267
 268    "Pmetrics#" &
 269    "Ladefault_switches#" &
 270    "Lbswitches#" &
 271
 272    --  package Ide
 273
 274    "Pide#" &
 275    "Ladefault_switches#" &
 276    "SVremote_host#" &
 277    "SVprogram_host#" &
 278    "SVcommunication_protocol#" &
 279    "Sacompiler_command#" &
 280    "SVdebugger_command#" &
 281    "SVgnatlist#" &
 282    "SVvcs_kind#" &
 283    "SVvcs_file_check#" &
 284    "SVvcs_log_check#" &
 285
 286    --  package Stack
 287
 288    "Pstack#" &
 289    "LVswitches#" &
 290
 291    "#";
 292
 293    Initialized : Boolean := False;
 294    --  A flag to avoid multiple initialization
 295
 296    function Name_Id_Of (Name : String) return Name_Id;
 297    --  Returns the Name_Id for Name in lower case
 298
 299    -----------------------
 300    -- Attribute_Kind_Of --
 301    -----------------------
 302
 303    function Attribute_Kind_Of
 304      (Attribute : Attribute_Node_Id) return Attribute_Kind
 305    is
 306    begin
 307       if Attribute = Empty_Attribute then
 308          return Unknown;
 309       else
 310          return Attrs.Table (Attribute.Value).Attr_Kind;
 311       end if;
 312    end Attribute_Kind_Of;
 313
 314    -----------------------
 315    -- Attribute_Name_Of --
 316    -----------------------
 317
 318    function Attribute_Name_Of (Attribute : Attribute_Node_Id) return Name_Id is
 319    begin
 320       if Attribute = Empty_Attribute then
 321          return No_Name;
 322       else
 323          return Attrs.Table (Attribute.Value).Name;
 324       end if;
 325    end Attribute_Name_Of;
 326
 327    --------------------------
 328    -- Attribute_Node_Id_Of --
 329    --------------------------
 330
 331    function Attribute_Node_Id_Of
 332      (Name        : Name_Id;
 333       Starting_At : Attribute_Node_Id) return Attribute_Node_Id
 334    is
 335       Id : Attr_Node_Id := Starting_At.Value;
 336
 337    begin
 338       while Id /= Empty_Attr
 339         and then Attrs.Table (Id).Name /= Name
 340       loop
 341          Id := Attrs.Table (Id).Next;
 342       end loop;
 343
 344       return (Value => Id);
 345    end Attribute_Node_Id_Of;
 346
 347    ----------------
 348    -- Initialize --
 349    ----------------
 350
 351    procedure Initialize is
 352       Start             : Positive          := Initialization_Data'First;
 353       Finish            : Positive          := Start;
 354       Current_Package   : Pkg_Node_Id       := Empty_Pkg;
 355       Current_Attribute : Attr_Node_Id      := Empty_Attr;
 356       Is_An_Attribute   : Boolean           := False;
 357       Var_Kind          : Variable_Kind     := Undefined;
 358       Optional_Index    : Boolean           := False;
 359       Attr_Kind         : Attribute_Kind    := Single;
 360       Package_Name      : Name_Id           := No_Name;
 361       Attribute_Name    : Name_Id           := No_Name;
 362       First_Attribute   : Attr_Node_Id      := Attr.First_Attribute;
 363       Read_Only         : Boolean;
 364
 365       function Attribute_Location return String;
 366       --  Returns a string depending if we are in the project level attributes
 367       --  or in the attributes of a package.
 368
 369       ------------------------
 370       -- Attribute_Location --
 371       ------------------------
 372
 373       function Attribute_Location return String is
 374       begin
 375          if Package_Name = No_Name then
 376             return "project level attributes";
 377
 378          else
 379             return "attribute of package """ &
 380             Get_Name_String (Package_Name) & """";
 381          end if;
 382       end Attribute_Location;
 383
 384    --  Start of processing for Initialize
 385
 386    begin
 387       --  Don't allow Initialize action to be repeated
 388
 389       if Initialized then
 390          return;
 391       end if;
 392
 393       --  Make sure the two tables are empty
 394
 395       Attrs.Init;
 396       Package_Attributes.Init;
 397
 398       while Initialization_Data (Start) /= '#' loop
 399          Is_An_Attribute := True;
 400          case Initialization_Data (Start) is
 401             when 'P' =>
 402
 403                --  New allowed package
 404
 405                Start := Start + 1;
 406
 407                Finish := Start;
 408                while Initialization_Data (Finish) /= '#' loop
 409                   Finish := Finish + 1;
 410                end loop;
 411
 412                Package_Name :=
 413                  Name_Id_Of (Initialization_Data (Start .. Finish - 1));
 414
 415                for Index in First_Package .. Package_Attributes.Last loop
 416                   if Package_Name = Package_Attributes.Table (Index).Name then
 417                      Osint.Fail ("duplicate name """,
 418                            Initialization_Data (Start .. Finish - 1),
 419                            """ in predefined packages.");
 420                   end if;
 421                end loop;
 422
 423                Is_An_Attribute := False;
 424                Current_Attribute := Empty_Attr;
 425                Package_Attributes.Increment_Last;
 426                Current_Package := Package_Attributes.Last;
 427                Package_Attributes.Table (Current_Package) :=
 428                  (Name             => Package_Name,
 429                   Known            => True,
 430                   First_Attribute  => Empty_Attr);
 431                Start := Finish + 1;
 432
 433             when 'S' =>
 434                Var_Kind       := Single;
 435                Optional_Index := False;
 436
 437             when 's' =>
 438                Var_Kind       := Single;
 439                Optional_Index := True;
 440
 441             when 'L' =>
 442                Var_Kind       := List;
 443                Optional_Index := False;
 444
 445             when 'l' =>
 446                Var_Kind         := List;
 447                Optional_Index := True;
 448
 449             when others =>
 450                raise Program_Error;
 451          end case;
 452
 453          if Is_An_Attribute then
 454
 455             --  New attribute
 456
 457             Start := Start + 1;
 458             case Initialization_Data (Start) is
 459                when 'V' =>
 460                   Attr_Kind := Single;
 461
 462                when 'A' =>
 463                   Attr_Kind := Associative_Array;
 464
 465                when 'a' =>
 466                   Attr_Kind := Case_Insensitive_Associative_Array;
 467
 468                when 'b' =>
 469                   if Osint.File_Names_Case_Sensitive then
 470                      Attr_Kind := Associative_Array;
 471                   else
 472                      Attr_Kind := Case_Insensitive_Associative_Array;
 473                   end if;
 474
 475                when 'c' =>
 476                   if Osint.File_Names_Case_Sensitive then
 477                      Attr_Kind := Optional_Index_Associative_Array;
 478                   else
 479                      Attr_Kind :=
 480                        Optional_Index_Case_Insensitive_Associative_Array;
 481                   end if;
 482
 483                when others =>
 484                   raise Program_Error;
 485             end case;
 486
 487             Start := Start + 1;
 488
 489             if Initialization_Data (Start) = 'R' then
 490                Read_Only := True;
 491                Start := Start + 1;
 492
 493             else
 494                Read_Only := False;
 495             end if;
 496
 497             Finish := Start;
 498
 499             while Initialization_Data (Finish) /= '#' loop
 500                Finish := Finish + 1;
 501             end loop;
 502
 503             Attribute_Name :=
 504               Name_Id_Of (Initialization_Data (Start .. Finish - 1));
 505             Attrs.Increment_Last;
 506
 507             if Current_Attribute = Empty_Attr then
 508                First_Attribute := Attrs.Last;
 509
 510                if Current_Package /= Empty_Pkg then
 511                   Package_Attributes.Table (Current_Package).First_Attribute
 512                     := Attrs.Last;
 513                end if;
 514
 515             else
 516                --  Check that there are no duplicate attributes
 517
 518                for Index in First_Attribute .. Attrs.Last - 1 loop
 519                   if Attribute_Name = Attrs.Table (Index).Name then
 520                      Osint.Fail ("duplicate attribute """,
 521                            Initialization_Data (Start .. Finish - 1),
 522                            """ in " & Attribute_Location);
 523                   end if;
 524                end loop;
 525
 526                Attrs.Table (Current_Attribute).Next :=
 527                  Attrs.Last;
 528             end if;
 529
 530             Current_Attribute := Attrs.Last;
 531             Attrs.Table (Current_Attribute) :=
 532               (Name           => Attribute_Name,
 533                Var_Kind       => Var_Kind,
 534                Optional_Index => Optional_Index,
 535                Attr_Kind      => Attr_Kind,
 536                Read_Only      => Read_Only,
 537                Next           => Empty_Attr);
 538             Start := Finish + 1;
 539          end if;
 540       end loop;
 541
 542       Initialized := True;
 543    end Initialize;
 544
 545    ------------------
 546    -- Is_Read_Only --
 547    ------------------
 548
 549    function Is_Read_Only (Attribute : Attribute_Node_Id) return Boolean is
 550    begin
 551       return Attrs.Table (Attribute.Value).Read_Only;
 552    end Is_Read_Only;
 553
 554    ----------------
 555    -- Name_Id_Of --
 556    ----------------
 557
 558    function Name_Id_Of (Name : String) return Name_Id is
 559    begin
 560       Name_Len := 0;
 561       Add_Str_To_Name_Buffer (Name);
 562       To_Lower (Name_Buffer (1 .. Name_Len));
 563       return Name_Find;
 564    end Name_Id_Of;
 565
 566    --------------------
 567    -- Next_Attribute --
 568    --------------------
 569
 570    function Next_Attribute
 571      (After : Attribute_Node_Id) return Attribute_Node_Id
 572    is
 573    begin
 574       if After = Empty_Attribute then
 575          return Empty_Attribute;
 576       else
 577          return (Value => Attrs.Table (After.Value).Next);
 578       end if;
 579    end Next_Attribute;
 580
 581    -----------------------
 582    -- Optional_Index_Of --
 583    -----------------------
 584
 585    function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean is
 586    begin
 587       if Attribute = Empty_Attribute then
 588          return False;
 589       else
 590          return Attrs.Table (Attribute.Value).Optional_Index;
 591       end if;
 592    end Optional_Index_Of;
 593
 594    ------------------------
 595    -- Package_Node_Id_Of --
 596    ------------------------
 597
 598    function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id is
 599    begin
 600       for Index in Package_Attributes.First .. Package_Attributes.Last loop
 601          if Package_Attributes.Table (Index).Name = Name then
 602             return (Value => Index);
 603          end if;
 604       end loop;
 605
 606       --  If there is no package with this name, return Empty_Package
 607
 608       return Empty_Package;
 609    end Package_Node_Id_Of;
 610
 611    ----------------------------
 612    -- Register_New_Attribute --
 613    ----------------------------
 614
 615    procedure Register_New_Attribute
 616      (Name               : String;
 617       In_Package         : Package_Node_Id;
 618       Attr_Kind          : Defined_Attribute_Kind;
 619       Var_Kind           : Defined_Variable_Kind;
 620       Index_Is_File_Name : Boolean := False;
 621       Opt_Index          : Boolean := False)
 622    is
 623       Attr_Name       : Name_Id;
 624       First_Attr      : Attr_Node_Id := Empty_Attr;
 625       Curr_Attr       : Attr_Node_Id;
 626       Real_Attr_Kind  : Attribute_Kind;
 627
 628    begin
 629       if Name'Length = 0 then
 630          Fail ("cannot register an attribute with no name");
 631          raise Project_Error;
 632       end if;
 633
 634       if In_Package = Empty_Package then
 635          Fail ("attempt to add attribute """, Name,
 636                """ to an undefined package");
 637          raise Project_Error;
 638       end if;
 639
 640       Attr_Name := Name_Id_Of (Name);
 641
 642       First_Attr :=
 643         Package_Attributes.Table (In_Package.Value).First_Attribute;
 644
 645       --  Check if attribute name is a duplicate
 646
 647       Curr_Attr := First_Attr;
 648       while Curr_Attr /= Empty_Attr loop
 649          if Attrs.Table (Curr_Attr).Name = Attr_Name then
 650             Fail ("duplicate attribute name """, Name,
 651                   """ in package """ &
 652                   Get_Name_String
 653                     (Package_Attributes.Table (In_Package.Value).Name) &
 654                   """");
 655             raise Project_Error;
 656          end if;
 657
 658          Curr_Attr := Attrs.Table (Curr_Attr).Next;
 659       end loop;
 660
 661       Real_Attr_Kind := Attr_Kind;
 662
 663       --  If Index_Is_File_Name, change the attribute kind if necessary
 664
 665       if Index_Is_File_Name and then not Osint.File_Names_Case_Sensitive then
 666          case Attr_Kind is
 667             when Associative_Array =>
 668                Real_Attr_Kind := Case_Insensitive_Associative_Array;
 669
 670             when Optional_Index_Associative_Array =>
 671                Real_Attr_Kind :=
 672                  Optional_Index_Case_Insensitive_Associative_Array;
 673
 674             when others =>
 675                null;
 676          end case;
 677       end if;
 678
 679       --  Add the new attribute
 680
 681       Attrs.Increment_Last;
 682       Attrs.Table (Attrs.Last) :=
 683         (Name           => Attr_Name,
 684          Var_Kind       => Var_Kind,
 685          Optional_Index => Opt_Index,
 686          Attr_Kind      => Real_Attr_Kind,
 687          Read_Only      => False,
 688          Next           => First_Attr);
 689       Package_Attributes.Table (In_Package.Value).First_Attribute :=
 690         Attrs.Last;
 691    end Register_New_Attribute;
 692
 693    --------------------------
 694    -- Register_New_Package --
 695    --------------------------
 696
 697    procedure Register_New_Package (Name : String; Id : out Package_Node_Id) is
 698       Pkg_Name : Name_Id;
 699
 700    begin
 701       if Name'Length = 0 then
 702          Fail ("cannot register a package with no name");
 703          Id := Empty_Package;
 704          return;
 705       end if;
 706
 707       Pkg_Name := Name_Id_Of (Name);
 708
 709       for Index in Package_Attributes.First .. Package_Attributes.Last loop
 710          if Package_Attributes.Table (Index).Name = Pkg_Name then
 711             Fail ("cannot register a package with a non unique name""",
 712                   Name, """");
 713             Id := Empty_Package;
 714             return;
 715          end if;
 716       end loop;
 717
 718       Package_Attributes.Increment_Last;
 719       Id := (Value => Package_Attributes.Last);
 720       Package_Attributes.Table (Package_Attributes.Last) :=
 721         (Name             => Pkg_Name,
 722          Known            => True,
 723          First_Attribute  => Empty_Attr);
 724    end Register_New_Package;
 725
 726    procedure Register_New_Package
 727      (Name       : String;
 728       Attributes : Attribute_Data_Array)
 729    is
 730       Pkg_Name   : Name_Id;
 731       Attr_Name  : Name_Id;
 732       First_Attr : Attr_Node_Id := Empty_Attr;
 733       Curr_Attr  : Attr_Node_Id;
 734       Attr_Kind  : Attribute_Kind;
 735
 736    begin
 737       if Name'Length = 0 then
 738          Fail ("cannot register a package with no name");
 739          raise Project_Error;
 740       end if;
 741
 742       Pkg_Name := Name_Id_Of (Name);
 743
 744       for Index in Package_Attributes.First .. Package_Attributes.Last loop
 745          if Package_Attributes.Table (Index).Name = Pkg_Name then
 746             Fail ("cannot register a package with a non unique name""",
 747                   Name, """");
 748             raise Project_Error;
 749          end if;
 750       end loop;
 751
 752       for Index in Attributes'Range loop
 753          Attr_Name := Name_Id_Of (Attributes (Index).Name);
 754
 755          Curr_Attr := First_Attr;
 756          while Curr_Attr /= Empty_Attr loop
 757             if Attrs.Table (Curr_Attr).Name = Attr_Name then
 758                Fail ("duplicate attribute name """, Attributes (Index).Name,
 759                      """ in new package """ & Name & """");
 760                raise Project_Error;
 761             end if;
 762
 763             Curr_Attr := Attrs.Table (Curr_Attr).Next;
 764          end loop;
 765
 766          Attr_Kind := Attributes (Index).Attr_Kind;
 767
 768          if Attributes (Index).Index_Is_File_Name
 769            and then not Osint.File_Names_Case_Sensitive
 770          then
 771             case Attr_Kind is
 772                when Associative_Array =>
 773                   Attr_Kind := Case_Insensitive_Associative_Array;
 774
 775                when Optional_Index_Associative_Array =>
 776                   Attr_Kind :=
 777                     Optional_Index_Case_Insensitive_Associative_Array;
 778
 779                when others =>
 780                   null;
 781             end case;
 782          end if;
 783
 784          Attrs.Increment_Last;
 785          Attrs.Table (Attrs.Last) :=
 786            (Name           => Attr_Name,
 787             Var_Kind       => Attributes (Index).Var_Kind,
 788             Optional_Index => Attributes (Index).Opt_Index,
 789             Attr_Kind      => Attr_Kind,
 790             Read_Only      => False,
 791             Next           => First_Attr);
 792          First_Attr := Attrs.Last;
 793       end loop;
 794
 795       Package_Attributes.Increment_Last;
 796       Package_Attributes.Table (Package_Attributes.Last) :=
 797         (Name             => Pkg_Name,
 798          Known            => True,
 799          First_Attribute  => First_Attr);
 800    end Register_New_Package;
 801
 802    ---------------------------
 803    -- Set_Attribute_Kind_Of --
 804    ---------------------------
 805
 806    procedure Set_Attribute_Kind_Of
 807      (Attribute : Attribute_Node_Id;
 808       To        : Attribute_Kind)
 809    is
 810    begin
 811       if Attribute /= Empty_Attribute then
 812          Attrs.Table (Attribute.Value).Attr_Kind := To;
 813       end if;
 814    end Set_Attribute_Kind_Of;
 815
 816    --------------------------
 817    -- Set_Variable_Kind_Of --
 818    --------------------------
 819
 820    procedure Set_Variable_Kind_Of
 821      (Attribute : Attribute_Node_Id;
 822       To        : Variable_Kind)
 823    is
 824    begin
 825       if Attribute /= Empty_Attribute then
 826          Attrs.Table (Attribute.Value).Var_Kind := To;
 827       end if;
 828    end Set_Variable_Kind_Of;
 829
 830    ----------------------
 831    -- Variable_Kind_Of --
 832    ----------------------
 833
 834    function Variable_Kind_Of
 835      (Attribute : Attribute_Node_Id) return Variable_Kind
 836    is
 837    begin
 838       if Attribute = Empty_Attribute then
 839          return Undefined;
 840       else
 841          return Attrs.Table (Attribute.Value).Var_Kind;
 842       end if;
 843    end Variable_Kind_Of;
 844
 845    ------------------------
 846    -- First_Attribute_Of --
 847    ------------------------
 848
 849    function First_Attribute_Of
 850      (Pkg : Package_Node_Id) return Attribute_Node_Id
 851    is
 852    begin
 853       if Pkg = Empty_Package then
 854          return Empty_Attribute;
 855       else
 856          return
 857            (Value => Package_Attributes.Table (Pkg.Value).First_Attribute);
 858       end if;
 859    end First_Attribute_Of;
 860
 861 end Prj.Attr;