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