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