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