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