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