1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 2001-2002 Free Software Foundation, Inc --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 with Errout
; use Errout
;
29 with Namet
; use Namet
;
30 with Prj
.Strt
; use Prj
.Strt
;
31 with Prj
.Tree
; use Prj
.Tree
;
32 with Scans
; use Scans
;
33 with Sinfo
; use Sinfo
;
34 with Types
; use Types
;
35 with Prj
.Attr
; use Prj
.Attr
;
37 package body Prj
.Dect
is
39 type Zone
is (In_Project
, In_Package
, In_Case_Construction
);
40 -- Needs a comment ???
42 procedure Parse_Attribute_Declaration
43 (Attribute
: out Project_Node_Id
;
44 First_Attribute
: Attribute_Node_Id
;
45 Current_Project
: Project_Node_Id
;
46 Current_Package
: Project_Node_Id
);
47 -- Parse an attribute declaration.
49 procedure Parse_Case_Construction
50 (Case_Construction
: out Project_Node_Id
;
51 First_Attribute
: Attribute_Node_Id
;
52 Current_Project
: Project_Node_Id
;
53 Current_Package
: Project_Node_Id
);
54 -- Parse a case construction
56 procedure Parse_Declarative_Items
57 (Declarations
: out Project_Node_Id
;
59 First_Attribute
: Attribute_Node_Id
;
60 Current_Project
: Project_Node_Id
;
61 Current_Package
: Project_Node_Id
);
62 -- Parse declarative items. Depending on In_Zone, some declarative
63 -- items may be forbiden.
65 procedure Parse_Package_Declaration
66 (Package_Declaration
: out Project_Node_Id
;
67 Current_Project
: Project_Node_Id
);
68 -- Parse a package declaration
70 procedure Parse_String_Type_Declaration
71 (String_Type
: out Project_Node_Id
;
72 Current_Project
: Project_Node_Id
);
73 -- type <name> is ( <literal_string> { , <literal_string> } ) ;
75 procedure Parse_Variable_Declaration
76 (Variable
: out Project_Node_Id
;
77 Current_Project
: Project_Node_Id
;
78 Current_Package
: Project_Node_Id
);
79 -- Parse a variable assignment
80 -- <variable_Name> := <expression>; OR
81 -- <variable_Name> : <string_type_Name> := <string_expression>;
88 (Declarations
: out Project_Node_Id
;
89 Current_Project
: Project_Node_Id
;
90 Extends
: Project_Node_Id
)
92 First_Declarative_Item
: Project_Node_Id
:= Empty_Node
;
95 Declarations
:= Default_Project_Node
(Of_Kind
=> N_Project_Declaration
);
96 Set_Location_Of
(Declarations
, To
=> Token_Ptr
);
97 Set_Modified_Project_Of
(Declarations
, To
=> Extends
);
98 Set_Project_Declaration_Of
(Current_Project
, Declarations
);
99 Parse_Declarative_Items
100 (Declarations
=> First_Declarative_Item
,
101 In_Zone
=> In_Project
,
102 First_Attribute
=> Prj
.Attr
.Attribute_First
,
103 Current_Project
=> Current_Project
,
104 Current_Package
=> Empty_Node
);
105 Set_First_Declarative_Item_Of
106 (Declarations
, To
=> First_Declarative_Item
);
109 ---------------------------------
110 -- Parse_Attribute_Declaration --
111 ---------------------------------
113 procedure Parse_Attribute_Declaration
114 (Attribute
: out Project_Node_Id
;
115 First_Attribute
: Attribute_Node_Id
;
116 Current_Project
: Project_Node_Id
;
117 Current_Package
: Project_Node_Id
)
119 Current_Attribute
: Attribute_Node_Id
:= First_Attribute
;
122 Attribute
:= Default_Project_Node
(Of_Kind
=> N_Attribute_Declaration
);
123 Set_Location_Of
(Attribute
, To
=> Token_Ptr
);
129 Expect
(Tok_Identifier
, "identifier");
131 if Token
= Tok_Identifier
then
132 Set_Name_Of
(Attribute
, To
=> Token_Name
);
133 Set_Location_Of
(Attribute
, To
=> Token_Ptr
);
135 while Current_Attribute
/= Empty_Attribute
137 Attributes
.Table
(Current_Attribute
).Name
/= Token_Name
139 Current_Attribute
:= Attributes
.Table
(Current_Attribute
).Next
;
142 if Current_Attribute
= Empty_Attribute
then
143 Error_Msg
("undefined attribute """ &
144 Get_Name_String
(Name_Of
(Attribute
)) &
148 elsif Attributes
.Table
(Current_Attribute
).Kind_2
=
149 Case_Insensitive_Associative_Array
151 Set_Case_Insensitive
(Attribute
, To
=> True);
157 if Token
= Tok_Left_Paren
then
158 if Current_Attribute
/= Empty_Attribute
159 and then Attributes
.Table
(Current_Attribute
).Kind_2
= Single
161 Error_Msg
("the attribute """ &
163 (Attributes
.Table
(Current_Attribute
).Name
) &
164 """ cannot be an associative array",
165 Location_Of
(Attribute
));
169 Expect
(Tok_String_Literal
, "literal string");
171 if Token
= Tok_String_Literal
then
172 Set_Associative_Array_Index_Of
(Attribute
, Strval
(Token_Node
));
176 Expect
(Tok_Right_Paren
, ")");
178 if Token
= Tok_Right_Paren
then
183 if Current_Attribute
/= Empty_Attribute
185 Attributes
.Table
(Current_Attribute
).Kind_2
/= Single
187 Error_Msg
("the attribute """ &
189 (Attributes
.Table
(Current_Attribute
).Name
) &
190 """ needs to be an associative array",
191 Location_Of
(Attribute
));
195 if Current_Attribute
/= Empty_Attribute
then
196 Set_Expression_Kind_Of
197 (Attribute
, To
=> Attributes
.Table
(Current_Attribute
).Kind_1
);
200 Expect
(Tok_Use
, "use");
202 if Token
= Tok_Use
then
206 Expression_Location
: constant Source_Ptr
:= Token_Ptr
;
207 Expression
: Project_Node_Id
:= Empty_Node
;
211 (Expression
=> Expression
,
212 Current_Project
=> Current_Project
,
213 Current_Package
=> Current_Package
);
214 Set_Expression_Of
(Attribute
, To
=> Expression
);
216 if Current_Attribute
/= Empty_Attribute
217 and then Expression
/= Empty_Node
218 and then Attributes
.Table
(Current_Attribute
).Kind_1
/=
219 Expression_Kind_Of
(Expression
)
222 ("wrong expression kind for attribute """ &
224 (Attributes
.Table
(Current_Attribute
).Name
) &
226 Expression_Location
);
231 end Parse_Attribute_Declaration
;
233 -----------------------------
234 -- Parse_Case_Construction --
235 -----------------------------
237 procedure Parse_Case_Construction
238 (Case_Construction
: out Project_Node_Id
;
239 First_Attribute
: Attribute_Node_Id
;
240 Current_Project
: Project_Node_Id
;
241 Current_Package
: Project_Node_Id
)
243 Current_Item
: Project_Node_Id
:= Empty_Node
;
244 Next_Item
: Project_Node_Id
:= Empty_Node
;
245 First_Case_Item
: Boolean := True;
247 Variable_Location
: Source_Ptr
:= No_Location
;
249 String_Type
: Project_Node_Id
:= Empty_Node
;
251 Case_Variable
: Project_Node_Id
:= Empty_Node
;
253 First_Declarative_Item
: Project_Node_Id
:= Empty_Node
;
255 First_Choice
: Project_Node_Id
:= Empty_Node
;
259 Default_Project_Node
(Of_Kind
=> N_Case_Construction
);
260 Set_Location_Of
(Case_Construction
, To
=> Token_Ptr
);
266 -- Get the switch variable
268 Expect
(Tok_Identifier
, "identifier");
270 if Token
= Tok_Identifier
then
271 Variable_Location
:= Token_Ptr
;
272 Parse_Variable_Reference
273 (Variable
=> Case_Variable
,
274 Current_Project
=> Current_Project
,
275 Current_Package
=> Current_Package
);
276 Set_Case_Variable_Reference_Of
277 (Case_Construction
, To
=> Case_Variable
);
280 if Token
/= Tok_Is
then
285 if Case_Variable
/= Empty_Node
then
286 String_Type
:= String_Type_Of
(Case_Variable
);
288 if String_Type
= Empty_Node
then
289 Error_Msg
("variable """ &
290 Get_Name_String
(Name_Of
(Case_Variable
)) &
296 Expect
(Tok_Is
, "is");
298 if Token
= Tok_Is
then
305 Start_New_Case_Construction
(String_Type
);
309 while Token
= Tok_When
loop
311 if First_Case_Item
then
312 Current_Item
:= Default_Project_Node
(Of_Kind
=> N_Case_Item
);
313 Set_First_Case_Item_Of
(Case_Construction
, To
=> Current_Item
);
314 First_Case_Item
:= False;
317 Next_Item
:= Default_Project_Node
(Of_Kind
=> N_Case_Item
);
318 Set_Next_Case_Item
(Current_Item
, To
=> Next_Item
);
319 Current_Item
:= Next_Item
;
322 Set_Location_Of
(Current_Item
, To
=> Token_Ptr
);
328 if Token
= Tok_Others
then
330 -- Scan past "others"
334 Expect
(Tok_Arrow
, "=>");
336 -- Empty_Node in Field1 of a Case_Item indicates
337 -- the "when others =>" branch.
339 Set_First_Choice_Of
(Current_Item
, To
=> Empty_Node
);
341 Parse_Declarative_Items
342 (Declarations
=> First_Declarative_Item
,
343 In_Zone
=> In_Case_Construction
,
344 First_Attribute
=> First_Attribute
,
345 Current_Project
=> Current_Project
,
346 Current_Package
=> Current_Package
);
348 -- "when others =>" must be the last branch, so save the
349 -- Case_Item and exit
351 Set_First_Declarative_Item_Of
352 (Current_Item
, To
=> First_Declarative_Item
);
356 Parse_Choice_List
(First_Choice
=> First_Choice
);
357 Set_First_Choice_Of
(Current_Item
, To
=> First_Choice
);
359 Expect
(Tok_Arrow
, "=>");
361 Parse_Declarative_Items
362 (Declarations
=> First_Declarative_Item
,
363 In_Zone
=> In_Case_Construction
,
364 First_Attribute
=> First_Attribute
,
365 Current_Project
=> Current_Project
,
366 Current_Package
=> Current_Package
);
368 Set_First_Declarative_Item_Of
369 (Current_Item
, To
=> First_Declarative_Item
);
374 End_Case_Construction
;
376 Expect
(Tok_End
, "end case");
378 if Token
= Tok_End
then
384 Expect
(Tok_Case
, "case");
392 Expect
(Tok_Semicolon
, ";");
394 end Parse_Case_Construction
;
396 -----------------------------
397 -- Parse_Declarative_Items --
398 -----------------------------
400 procedure Parse_Declarative_Items
401 (Declarations
: out Project_Node_Id
;
403 First_Attribute
: Attribute_Node_Id
;
404 Current_Project
: Project_Node_Id
;
405 Current_Package
: Project_Node_Id
)
407 Current_Declarative_Item
: Project_Node_Id
:= Empty_Node
;
408 Next_Declarative_Item
: Project_Node_Id
:= Empty_Node
;
409 Current_Declaration
: Project_Node_Id
:= Empty_Node
;
410 Item_Location
: Source_Ptr
:= No_Location
;
413 Declarations
:= Empty_Node
;
416 -- We are always positioned at the token that precedes
417 -- the first token of the declarative element.
422 Item_Location
:= Token_Ptr
;
425 when Tok_Identifier
=>
427 if In_Zone
= In_Case_Construction
then
428 Error_Msg
("a variable cannot be declared here",
432 Parse_Variable_Declaration
433 (Current_Declaration
,
434 Current_Project
=> Current_Project
,
435 Current_Package
=> Current_Package
);
439 Parse_Attribute_Declaration
440 (Attribute
=> Current_Declaration
,
441 First_Attribute
=> First_Attribute
,
442 Current_Project
=> Current_Project
,
443 Current_Package
=> Current_Package
);
447 -- Package declaration
449 if In_Zone
/= In_Project
then
450 Error_Msg
("a package cannot be declared here", Token_Ptr
);
453 Parse_Package_Declaration
454 (Package_Declaration
=> Current_Declaration
,
455 Current_Project
=> Current_Project
);
459 -- Type String Declaration
461 if In_Zone
/= In_Project
then
462 Error_Msg
("a string type cannot be declared here",
466 Parse_String_Type_Declaration
467 (String_Type
=> Current_Declaration
,
468 Current_Project
=> Current_Project
);
474 Parse_Case_Construction
475 (Case_Construction
=> Current_Declaration
,
476 First_Attribute
=> First_Attribute
,
477 Current_Project
=> Current_Project
,
478 Current_Package
=> Current_Package
);
483 -- We are leaving Parse_Declarative_Items positionned
484 -- at the first token after the list of declarative items.
485 -- It could be "end" (for a project, a package declaration or
486 -- a case construction) or "when" (for a case construction)
490 Expect
(Tok_Semicolon
, "; after declarative items");
492 if Current_Declarative_Item
= Empty_Node
then
493 Current_Declarative_Item
:=
494 Default_Project_Node
(Of_Kind
=> N_Declarative_Item
);
495 Declarations
:= Current_Declarative_Item
;
498 Next_Declarative_Item
:=
499 Default_Project_Node
(Of_Kind
=> N_Declarative_Item
);
500 Set_Next_Declarative_Item
501 (Current_Declarative_Item
, To
=> Next_Declarative_Item
);
502 Current_Declarative_Item
:= Next_Declarative_Item
;
505 Set_Current_Item_Node
506 (Current_Declarative_Item
, To
=> Current_Declaration
);
507 Set_Location_Of
(Current_Declarative_Item
, To
=> Item_Location
);
511 end Parse_Declarative_Items
;
513 -------------------------------
514 -- Parse_Package_Declaration --
515 -------------------------------
517 procedure Parse_Package_Declaration
518 (Package_Declaration
: out Project_Node_Id
;
519 Current_Project
: Project_Node_Id
)
521 First_Attribute
: Attribute_Node_Id
:= Empty_Attribute
;
522 Current_Package
: Package_Node_Id
:= Empty_Package
;
523 First_Declarative_Item
: Project_Node_Id
:= Empty_Node
;
526 Package_Declaration
:=
527 Default_Project_Node
(Of_Kind
=> N_Package_Declaration
);
528 Set_Location_Of
(Package_Declaration
, To
=> Token_Ptr
);
530 -- Scan past "package"
534 Expect
(Tok_Identifier
, "identifier");
536 if Token
= Tok_Identifier
then
538 Set_Name_Of
(Package_Declaration
, To
=> Token_Name
);
540 for Index
in Package_Attributes
.First
.. Package_Attributes
.Last
loop
541 if Token_Name
= Package_Attributes
.Table
(Index
).Name
then
543 Package_Attributes
.Table
(Index
).First_Attribute
;
544 Current_Package
:= Index
;
549 if Current_Package
= Empty_Package
then
551 Get_Name_String
(Name_Of
(Package_Declaration
)) &
552 """ is not an allowed package name",
556 Set_Package_Id_Of
(Package_Declaration
, To
=> Current_Package
);
559 Current
: Project_Node_Id
:= First_Package_Of
(Current_Project
);
562 while Current
/= Empty_Node
563 and then Name_Of
(Current
) /= Token_Name
565 Current
:= Next_Package_In_Project
(Current
);
568 if Current
/= Empty_Node
then
571 Get_Name_String
(Name_Of
(Package_Declaration
)) &
572 """ is declared twice in the same project",
576 -- Add the package to the project list
578 Set_Next_Package_In_Project
579 (Package_Declaration
,
580 To
=> First_Package_Of
(Current_Project
));
582 (Current_Project
, To
=> Package_Declaration
);
587 -- Scan past the package name
592 if Token
= Tok_Renames
then
594 -- Scan past "renames"
598 Expect
(Tok_Identifier
, "identifier");
600 if Token
= Tok_Identifier
then
602 Project_Name
: Name_Id
:= Token_Name
;
603 Clause
: Project_Node_Id
:=
604 First_With_Clause_Of
(Current_Project
);
605 The_Project
: Project_Node_Id
:= Empty_Node
;
608 while Clause
/= Empty_Node
loop
609 The_Project
:= Project_Node_Of
(Clause
);
610 exit when Name_Of
(The_Project
) = Project_Name
;
611 Clause
:= Next_With_Clause_Of
(Clause
);
614 if Clause
= Empty_Node
then
616 Get_Name_String
(Project_Name
) &
617 """ is not an imported project", Token_Ptr
);
619 Set_Project_Of_Renamed_Package_Of
620 (Package_Declaration
, To
=> The_Project
);
625 Expect
(Tok_Dot
, ".");
627 if Token
= Tok_Dot
then
629 Expect
(Tok_Identifier
, "identifier");
631 if Token
= Tok_Identifier
then
632 if Name_Of
(Package_Declaration
) /= Token_Name
then
633 Error_Msg
("not the same package name", Token_Ptr
);
635 Project_Of_Renamed_Package_Of
(Package_Declaration
)
639 Current
: Project_Node_Id
:=
641 (Project_Of_Renamed_Package_Of
642 (Package_Declaration
));
645 while Current
/= Empty_Node
646 and then Name_Of
(Current
) /= Token_Name
648 Current
:= Next_Package_In_Project
(Current
);
651 if Current
= Empty_Node
then
654 Get_Name_String
(Token_Name
) &
655 """ is not a package declared by the project",
666 Expect
(Tok_Semicolon
, ";");
668 elsif Token
= Tok_Is
then
670 Parse_Declarative_Items
671 (Declarations
=> First_Declarative_Item
,
672 In_Zone
=> In_Package
,
673 First_Attribute
=> First_Attribute
,
674 Current_Project
=> Current_Project
,
675 Current_Package
=> Package_Declaration
);
677 Set_First_Declarative_Item_Of
678 (Package_Declaration
, To
=> First_Declarative_Item
);
680 Expect
(Tok_End
, "end");
682 if Token
= Tok_End
then
689 -- We should have the name of the package after "end"
691 Expect
(Tok_Identifier
, "identifier");
693 if Token
= Tok_Identifier
694 and then Name_Of
(Package_Declaration
) /= No_Name
695 and then Token_Name
/= Name_Of
(Package_Declaration
)
697 Error_Msg_Name_1
:= Name_Of
(Package_Declaration
);
698 Error_Msg
("expected {", Token_Ptr
);
701 if Token
/= Tok_Semicolon
then
703 -- Scan past the package name
708 Expect
(Tok_Semicolon
, ";");
711 Error_Msg
("expected ""is"" or ""renames""", Token_Ptr
);
714 end Parse_Package_Declaration
;
716 -----------------------------------
717 -- Parse_String_Type_Declaration --
718 -----------------------------------
720 procedure Parse_String_Type_Declaration
721 (String_Type
: out Project_Node_Id
;
722 Current_Project
: Project_Node_Id
)
724 Current
: Project_Node_Id
:= Empty_Node
;
725 First_String
: Project_Node_Id
:= Empty_Node
;
729 Default_Project_Node
(Of_Kind
=> N_String_Type_Declaration
);
731 Set_Location_Of
(String_Type
, To
=> Token_Ptr
);
737 Expect
(Tok_Identifier
, "identifier");
739 if Token
= Tok_Identifier
then
740 Set_Name_Of
(String_Type
, To
=> Token_Name
);
742 Current
:= First_String_Type_Of
(Current_Project
);
743 while Current
/= Empty_Node
745 Name_Of
(Current
) /= Token_Name
747 Current
:= Next_String_Type
(Current
);
750 if Current
/= Empty_Node
then
751 Error_Msg
("duplicate string type name """ &
752 Get_Name_String
(Token_Name
) &
756 Current
:= First_Variable_Of
(Current_Project
);
757 while Current
/= Empty_Node
758 and then Name_Of
(Current
) /= Token_Name
760 Current
:= Next_Variable
(Current
);
763 if Current
/= Empty_Node
then
765 Get_Name_String
(Token_Name
) &
766 """ is already a variable name", Token_Ptr
);
769 (String_Type
, To
=> First_String_Type_Of
(Current_Project
));
770 Set_First_String_Type_Of
(Current_Project
, To
=> String_Type
);
774 -- Scan past the name
779 Expect
(Tok_Is
, "is");
781 if Token
= Tok_Is
then
785 Expect
(Tok_Left_Paren
, "(");
787 if Token
= Tok_Left_Paren
then
791 Parse_String_Type_List
(First_String
=> First_String
);
792 Set_First_Literal_String
(String_Type
, To
=> First_String
);
794 Expect
(Tok_Right_Paren
, ")");
796 if Token
= Tok_Right_Paren
then
800 end Parse_String_Type_Declaration
;
802 --------------------------------
803 -- Parse_Variable_Declaration --
804 --------------------------------
806 procedure Parse_Variable_Declaration
807 (Variable
: out Project_Node_Id
;
808 Current_Project
: Project_Node_Id
;
809 Current_Package
: Project_Node_Id
)
811 Expression_Location
: Source_Ptr
;
812 String_Type_Name
: Name_Id
:= No_Name
;
813 Project_String_Type_Name
: Name_Id
:= No_Name
;
814 Type_Location
: Source_Ptr
:= No_Location
;
815 Project_Location
: Source_Ptr
:= No_Location
;
816 Expression
: Project_Node_Id
:= Empty_Node
;
817 Variable_Name
: constant Name_Id
:= Token_Name
;
821 Default_Project_Node
(Of_Kind
=> N_Variable_Declaration
);
822 Set_Name_Of
(Variable
, To
=> Variable_Name
);
823 Set_Location_Of
(Variable
, To
=> Token_Ptr
);
825 -- Scan past the variable name
829 if Token
= Tok_Colon
then
831 -- Typed string variable declaration
834 Set_Kind_Of
(Variable
, N_Typed_Variable_Declaration
);
835 Expect
(Tok_Identifier
, "identifier");
837 if Token
= Tok_Identifier
then
838 String_Type_Name
:= Token_Name
;
839 Type_Location
:= Token_Ptr
;
842 if Token
= Tok_Dot
then
843 Project_String_Type_Name
:= String_Type_Name
;
844 Project_Location
:= Type_Location
;
849 Expect
(Tok_Identifier
, "identifier");
851 if Token
= Tok_Identifier
then
852 String_Type_Name
:= Token_Name
;
853 Type_Location
:= Token_Ptr
;
856 String_Type_Name
:= No_Name
;
860 if String_Type_Name
/= No_Name
then
862 Current
: Project_Node_Id
:=
863 First_String_Type_Of
(Current_Project
);
866 if Project_String_Type_Name
/= No_Name
then
868 The_Project_Name_And_Node
: constant
869 Tree_Private_Part
.Project_Name_And_Node
:=
870 Tree_Private_Part
.Projects_Htable
.Get
871 (Project_String_Type_Name
);
873 use Tree_Private_Part
;
876 if The_Project_Name_And_Node
=
877 Tree_Private_Part
.No_Project_Name_And_Node
879 Error_Msg
("unknown project """ &
881 (Project_String_Type_Name
) &
884 Current
:= Empty_Node
;
888 (The_Project_Name_And_Node
.Node
);
893 while Current
/= Empty_Node
894 and then Name_Of
(Current
) /= String_Type_Name
896 Current
:= Next_String_Type
(Current
);
899 if Current
= Empty_Node
then
900 Error_Msg
("unknown string type """ &
901 Get_Name_String
(String_Type_Name
) &
906 (Variable
, To
=> Current
);
913 Expect
(Tok_Colon_Equal
, ":=");
915 if Token
= Tok_Colon_Equal
then
919 -- Get the single string or string list value
921 Expression_Location
:= Token_Ptr
;
924 (Expression
=> Expression
,
925 Current_Project
=> Current_Project
,
926 Current_Package
=> Current_Package
);
927 Set_Expression_Of
(Variable
, To
=> Expression
);
929 if Expression
/= Empty_Node
then
930 Set_Expression_Kind_Of
931 (Variable
, To
=> Expression_Kind_Of
(Expression
));
935 The_Variable
: Project_Node_Id
:= Empty_Node
;
938 if Current_Package
/= Empty_Node
then
939 The_Variable
:= First_Variable_Of
(Current_Package
);
940 elsif Current_Project
/= Empty_Node
then
941 The_Variable
:= First_Variable_Of
(Current_Project
);
944 while The_Variable
/= Empty_Node
945 and then Name_Of
(The_Variable
) /= Variable_Name
947 The_Variable
:= Next_Variable
(The_Variable
);
950 if The_Variable
= Empty_Node
then
951 if Current_Package
/= Empty_Node
then
953 (Variable
, To
=> First_Variable_Of
(Current_Package
));
954 Set_First_Variable_Of
(Current_Package
, To
=> Variable
);
956 elsif Current_Project
/= Empty_Node
then
958 (Variable
, To
=> First_Variable_Of
(Current_Project
));
959 Set_First_Variable_Of
(Current_Project
, To
=> Variable
);
963 if Expression_Kind_Of
(Variable
) /= Undefined
then
964 if Expression_Kind_Of
(The_Variable
) = Undefined
then
965 Set_Expression_Kind_Of
966 (The_Variable
, To
=> Expression_Kind_Of
(Variable
));
969 if Expression_Kind_Of
(The_Variable
) /=
970 Expression_Kind_Of
(Variable
)
972 Error_Msg
("wrong expression kind for variable """ &
973 Get_Name_String
(Name_Of
(The_Variable
)) &
975 Expression_Location
);
982 end Parse_Variable_Declaration
;