OSDN Git Service

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