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