?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Update concepts branch to revision 131834
[official-gcc.git] / gcc / ada / prj-dect.adb
blob1e15fb207dae330a5f99f5e69d9e61f44103a79a
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . D E C T --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2008, 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 Err_Vars; use Err_Vars;
27
28 with GNAT.Case_Util; use GNAT.Case_Util;
29 with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
30
31 with Opt; use Opt;
32 with Prj.Attr; use Prj.Attr;
33 with Prj.Attr.PM; use Prj.Attr.PM;
34 with Prj.Err; use Prj.Err;
35 with Prj.Strt; use Prj.Strt;
36 with Prj.Tree; use Prj.Tree;
37 with Snames;
38 with Uintp; use Uintp;
39
40 with GNAT.Strings;
41
42 package body Prj.Dect is
43
44 use GNAT;
45
46 type Zone is (In_Project, In_Package, In_Case_Construction);
47 -- Used to indicate if we are parsing a package (In_Package),
48 -- a case construction (In_Case_Construction) or none of those two
49 -- (In_Project).
50
51 procedure Parse_Attribute_Declaration
52 (In_Tree : Project_Node_Tree_Ref;
53 Attribute : out Project_Node_Id;
54 First_Attribute : Attribute_Node_Id;
55 Current_Project : Project_Node_Id;
56 Current_Package : Project_Node_Id;
57 Packages_To_Check : String_List_Access);
58 -- Parse an attribute declaration
59
60 procedure Parse_Case_Construction
61 (In_Tree : Project_Node_Tree_Ref;
62 Case_Construction : out Project_Node_Id;
63 First_Attribute : Attribute_Node_Id;
64 Current_Project : Project_Node_Id;
65 Current_Package : Project_Node_Id;
66 Packages_To_Check : String_List_Access);
67 -- Parse a case construction
68
69 procedure Parse_Declarative_Items
70 (In_Tree : Project_Node_Tree_Ref;
71 Declarations : out Project_Node_Id;
72 In_Zone : Zone;
73 First_Attribute : Attribute_Node_Id;
74 Current_Project : Project_Node_Id;
75 Current_Package : Project_Node_Id;
76 Packages_To_Check : String_List_Access);
77 -- Parse declarative items. Depending on In_Zone, some declarative
78 -- items may be forbidden.
79
80 procedure Parse_Package_Declaration
81 (In_Tree : Project_Node_Tree_Ref;
82 Package_Declaration : out Project_Node_Id;
83 Current_Project : Project_Node_Id;
84 Packages_To_Check : String_List_Access);
85 -- Parse a package declaration
86
87 procedure Parse_String_Type_Declaration
88 (In_Tree : Project_Node_Tree_Ref;
89 String_Type : out Project_Node_Id;
90 Current_Project : Project_Node_Id);
91 -- type <name> is ( <literal_string> { , <literal_string> } ) ;
92
93 procedure Parse_Variable_Declaration
94 (In_Tree : Project_Node_Tree_Ref;
95 Variable : out Project_Node_Id;
96 Current_Project : Project_Node_Id;
97 Current_Package : Project_Node_Id);
98 -- Parse a variable assignment
99 -- <variable_Name> := <expression>; OR
100 -- <variable_Name> : <string_type_Name> := <string_expression>;
101
102 -----------
103 -- Parse --
104 -----------
105
106 procedure Parse
107 (In_Tree : Project_Node_Tree_Ref;
108 Declarations : out Project_Node_Id;
109 Current_Project : Project_Node_Id;
110 Extends : Project_Node_Id;
111 Packages_To_Check : String_List_Access)
112 is
113 First_Declarative_Item : Project_Node_Id := Empty_Node;
114
115 begin
116 Declarations :=
117 Default_Project_Node
118 (Of_Kind => N_Project_Declaration, In_Tree => In_Tree);
119 Set_Location_Of (Declarations, In_Tree, To => Token_Ptr);
120 Set_Extended_Project_Of (Declarations, In_Tree, To => Extends);
121 Set_Project_Declaration_Of (Current_Project, In_Tree, Declarations);
122 Parse_Declarative_Items
123 (Declarations => First_Declarative_Item,
124 In_Tree => In_Tree,
125 In_Zone => In_Project,
126 First_Attribute => Prj.Attr.Attribute_First,
127 Current_Project => Current_Project,
128 Current_Package => Empty_Node,
129 Packages_To_Check => Packages_To_Check);
130 Set_First_Declarative_Item_Of
131 (Declarations, In_Tree, To => First_Declarative_Item);
132 end Parse;
133
134 ---------------------------------
135 -- Parse_Attribute_Declaration --
136 ---------------------------------
137
138 procedure Parse_Attribute_Declaration
139 (In_Tree : Project_Node_Tree_Ref;
140 Attribute : out Project_Node_Id;
141 First_Attribute : Attribute_Node_Id;
142 Current_Project : Project_Node_Id;
143 Current_Package : Project_Node_Id;
144 Packages_To_Check : String_List_Access)
145 is
146 Current_Attribute : Attribute_Node_Id := First_Attribute;
147 Full_Associative_Array : Boolean := False;
148 Attribute_Name : Name_Id := No_Name;
149 Optional_Index : Boolean := False;
150 Pkg_Id : Package_Node_Id := Empty_Package;
151 Ignore : Boolean := False;
152
153 begin
154 Attribute :=
155 Default_Project_Node
156 (Of_Kind => N_Attribute_Declaration, In_Tree => In_Tree);
157 Set_Location_Of (Attribute, In_Tree, To => Token_Ptr);
158 Set_Previous_Line_Node (Attribute);
159
160 -- Scan past "for"
161
162 Scan (In_Tree);
163
164 -- Body may be an attribute name
165
166 if Token = Tok_Body then
167 Token := Tok_Identifier;
168 Token_Name := Snames.Name_Body;
169 end if;
170
171 Expect (Tok_Identifier, "identifier");
172
173 if Token = Tok_Identifier then
174 Attribute_Name := Token_Name;
175 Set_Name_Of (Attribute, In_Tree, To => Token_Name);
176 Set_Location_Of (Attribute, In_Tree, To => Token_Ptr);
177
178 -- Find the attribute
179
180 Current_Attribute :=
181 Attribute_Node_Id_Of (Token_Name, First_Attribute);
182
183 -- If the attribute cannot be found, create the attribute if inside
184 -- an unknown package.
185
186 if Current_Attribute = Empty_Attribute then
187 if Present (Current_Package)
188 and then Expression_Kind_Of (Current_Package, In_Tree) = Ignored
189 then
190 Pkg_Id := Package_Id_Of (Current_Package, In_Tree);
191 Add_Attribute (Pkg_Id, Token_Name, Current_Attribute);
192
193 else
194 -- If not a valid attribute name, issue an error if inside
195 -- a package that need to be checked.
196
197 Ignore := Present (Current_Package) and then
198 Packages_To_Check /= All_Packages;
199
200 if Ignore then
201
202 -- Check that we are not in a package to check
203
204 Get_Name_String (Name_Of (Current_Package, In_Tree));
205
206 for Index in Packages_To_Check'Range loop
207 if Name_Buffer (1 .. Name_Len) =
208 Packages_To_Check (Index).all
209 then
210 Ignore := False;
211 exit;
212 end if;
213 end loop;
214 end if;
215
216 if not Ignore then
217 Error_Msg_Name_1 := Token_Name;
218 Error_Msg ("undefined attribute %%", Token_Ptr);
219 end if;
220 end if;
221
222 -- Set, if appropriate the index case insensitivity flag
223
224 else
225 if Is_Read_Only (Current_Attribute) then
226 Error_Msg
227 ("read-only attribute cannot be given a value",
228 Token_Ptr);
229 end if;
230
231 if Attribute_Kind_Of (Current_Attribute) in
232 Case_Insensitive_Associative_Array ..
233 Optional_Index_Case_Insensitive_Associative_Array
234 then
235 Set_Case_Insensitive (Attribute, In_Tree, To => True);
236 end if;
237 end if;
238
239 Scan (In_Tree); -- past the attribute name
240 end if;
241
242 -- Change obsolete names of attributes to the new names
243
244 if Present (Current_Package)
245 and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored
246 then
247 case Name_Of (Attribute, In_Tree) is
248 when Snames.Name_Specification =>
249 Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec);
250
251 when Snames.Name_Specification_Suffix =>
252 Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec_Suffix);
253
254 when Snames.Name_Implementation =>
255 Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body);
256
257 when Snames.Name_Implementation_Suffix =>
258 Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body_Suffix);
259
260 when others =>
261 null;
262 end case;
263 end if;
264
265 -- Associative array attributes
266
267 if Token = Tok_Left_Paren then
268
269 -- If the attribute is not an associative array attribute, report
270 -- an error. If this information is still unknown, set the kind
271 -- to Associative_Array.
272
273 if Current_Attribute /= Empty_Attribute
274 and then Attribute_Kind_Of (Current_Attribute) = Single
275 then
276 Error_Msg ("the attribute """ &
277 Get_Name_String
278 (Attribute_Name_Of (Current_Attribute)) &
279 """ cannot be an associative array",
280 Location_Of (Attribute, In_Tree));
281
282 elsif Attribute_Kind_Of (Current_Attribute) = Unknown then
283 Set_Attribute_Kind_Of (Current_Attribute, To => Associative_Array);
284 end if;
285
286 Scan (In_Tree); -- past the left parenthesis
287 Expect (Tok_String_Literal, "literal string");
288
289 if Token = Tok_String_Literal then
290 Get_Name_String (Token_Name);
291
292 if Case_Insensitive (Attribute, In_Tree) then
293 To_Lower (Name_Buffer (1 .. Name_Len));
294 end if;
295
296 Set_Associative_Array_Index_Of (Attribute, In_Tree, Name_Find);
297 Scan (In_Tree); -- past the literal string index
298
299 if Token = Tok_At then
300 case Attribute_Kind_Of (Current_Attribute) is
301 when Optional_Index_Associative_Array |
302 Optional_Index_Case_Insensitive_Associative_Array =>
303 Scan (In_Tree);
304 Expect (Tok_Integer_Literal, "integer literal");
305
306 if Token = Tok_Integer_Literal then
307
308 -- Set the source index value from given literal
309
310 declare
311 Index : constant Int :=
312 UI_To_Int (Int_Literal_Value);
313 begin
314 if Index = 0 then
315 Error_Msg ("index cannot be zero", Token_Ptr);
316 else
317 Set_Source_Index_Of
318 (Attribute, In_Tree, To => Index);
319 end if;
320 end;
321
322 Scan (In_Tree);
323 end if;
324
325 when others =>
326 Error_Msg ("index not allowed here", Token_Ptr);
327 Scan (In_Tree);
328
329 if Token = Tok_Integer_Literal then
330 Scan (In_Tree);
331 end if;
332 end case;
333 end if;
334 end if;
335
336 Expect (Tok_Right_Paren, "`)`");
337
338 if Token = Tok_Right_Paren then
339 Scan (In_Tree); -- past the right parenthesis
340 end if;
341
342 else
343 -- If it is an associative array attribute and there are no left
344 -- parenthesis, then this is a full associative array declaration.
345 -- Flag it as such for later processing of its value.
346
347 if Current_Attribute /= Empty_Attribute
348 and then
349 Attribute_Kind_Of (Current_Attribute) /= Single
350 then
351 if Attribute_Kind_Of (Current_Attribute) = Unknown then
352 Set_Attribute_Kind_Of (Current_Attribute, To => Single);
353
354 else
355 Full_Associative_Array := True;
356 end if;
357 end if;
358 end if;
359
360 -- Set the expression kind of the attribute
361
362 if Current_Attribute /= Empty_Attribute then
363 Set_Expression_Kind_Of
364 (Attribute, In_Tree, To => Variable_Kind_Of (Current_Attribute));
365 Optional_Index := Optional_Index_Of (Current_Attribute);
366 end if;
367
368 Expect (Tok_Use, "USE");
369
370 if Token = Tok_Use then
371 Scan (In_Tree);
372
373 if Full_Associative_Array then
374
375 -- Expect <project>'<same_attribute_name>, or
376 -- <project>.<same_package_name>'<same_attribute_name>
377
378 declare
379 The_Project : Project_Node_Id := Empty_Node;
380 -- The node of the project where the associative array is
381 -- declared.
382
383 The_Package : Project_Node_Id := Empty_Node;
384 -- The node of the package where the associative array is
385 -- declared, if any.
386
387 Project_Name : Name_Id := No_Name;
388 -- The name of the project where the associative array is
389 -- declared.
390
391 Location : Source_Ptr := No_Location;
392 -- The location of the project name
393
394 begin
395 Expect (Tok_Identifier, "identifier");
396
397 if Token = Tok_Identifier then
398 Location := Token_Ptr;
399
400 -- Find the project node in the imported project or
401 -- in the project being extended.
402
403 The_Project := Imported_Or_Extended_Project_Of
404 (Current_Project, In_Tree, Token_Name);
405
406 if No (The_Project) then
407 Error_Msg ("unknown project", Location);
408 Scan (In_Tree); -- past the project name
409
410 else
411 Project_Name := Token_Name;
412 Scan (In_Tree); -- past the project name
413
414 -- If this is inside a package, a dot followed by the
415 -- name of the package must followed the project name.
416
417 if Present (Current_Package) then
418 Expect (Tok_Dot, "`.`");
419
420 if Token /= Tok_Dot then
421 The_Project := Empty_Node;
422
423 else
424 Scan (In_Tree); -- past the dot
425 Expect (Tok_Identifier, "identifier");
426
427 if Token /= Tok_Identifier then
428 The_Project := Empty_Node;
429
430 -- If it is not the same package name, issue error
431
432 elsif
433 Token_Name /= Name_Of (Current_Package, In_Tree)
434 then
435 The_Project := Empty_Node;
436 Error_Msg
437 ("not the same package as " &
438 Get_Name_String
439 (Name_Of (Current_Package, In_Tree)),
440 Token_Ptr);
441
442 else
443 The_Package :=
444 First_Package_Of (The_Project, In_Tree);
445
446 -- Look for the package node
447
448 while Present (The_Package)
449 and then
450 Name_Of (The_Package, In_Tree) /= Token_Name
451 loop
452 The_Package :=
453 Next_Package_In_Project
454 (The_Package, In_Tree);
455 end loop;
456
457 -- If the package cannot be found in the
458 -- project, issue an error.
459
460 if No (The_Package) then
461 The_Project := Empty_Node;
462 Error_Msg_Name_2 := Project_Name;
463 Error_Msg_Name_1 := Token_Name;
464 Error_Msg
465 ("package % not declared in project %",
466 Token_Ptr);
467 end if;
468
469 Scan (In_Tree); -- past the package name
470 end if;
471 end if;
472 end if;
473 end if;
474 end if;
475
476 if Present (The_Project) then
477
478 -- Looking for '<same attribute name>
479
480 Expect (Tok_Apostrophe, "`''`");
481
482 if Token /= Tok_Apostrophe then
483 The_Project := Empty_Node;
484
485 else
486 Scan (In_Tree); -- past the apostrophe
487 Expect (Tok_Identifier, "identifier");
488
489 if Token /= Tok_Identifier then
490 The_Project := Empty_Node;
491
492 else
493 -- If it is not the same attribute name, issue error
494
495 if Token_Name /= Attribute_Name then
496 The_Project := Empty_Node;
497 Error_Msg_Name_1 := Attribute_Name;
498 Error_Msg ("invalid name, should be %", Token_Ptr);
499 end if;
500
501 Scan (In_Tree); -- past the attribute name
502 end if;
503 end if;
504 end if;
505
506 if No (The_Project) then
507
508 -- If there were any problem, set the attribute id to null,
509 -- so that the node will not be recorded.
510
511 Current_Attribute := Empty_Attribute;
512
513 else
514 -- Set the appropriate field in the node.
515 -- Note that the index and the expression are nil. This
516 -- characterizes full associative array attribute
517 -- declarations.
518
519 Set_Associative_Project_Of (Attribute, In_Tree, The_Project);
520 Set_Associative_Package_Of (Attribute, In_Tree, The_Package);
521 end if;
522 end;
523
524 -- Other attribute declarations (not full associative array)
525
526 else
527 declare
528 Expression_Location : constant Source_Ptr := Token_Ptr;
529 -- The location of the first token of the expression
530
531 Expression : Project_Node_Id := Empty_Node;
532 -- The expression, value for the attribute declaration
533
534 begin
535 -- Get the expression value and set it in the attribute node
536
537 Parse_Expression
538 (In_Tree => In_Tree,
539 Expression => Expression,
540 Current_Project => Current_Project,
541 Current_Package => Current_Package,
542 Optional_Index => Optional_Index);
543 Set_Expression_Of (Attribute, In_Tree, To => Expression);
544
545 -- If the expression is legal, but not of the right kind
546 -- for the attribute, issue an error.
547
548 if Current_Attribute /= Empty_Attribute
549 and then Present (Expression)
550 and then Variable_Kind_Of (Current_Attribute) /=
551 Expression_Kind_Of (Expression, In_Tree)
552 then
553 if Variable_Kind_Of (Current_Attribute) = Undefined then
554 Set_Variable_Kind_Of
555 (Current_Attribute,
556 To => Expression_Kind_Of (Expression, In_Tree));
557
558 else
559 Error_Msg
560 ("wrong expression kind for attribute """ &
561 Get_Name_String
562 (Attribute_Name_Of (Current_Attribute)) &
563 """",
564 Expression_Location);
565 end if;
566 end if;
567 end;
568 end if;
569 end if;
570
571 -- If the attribute was not recognized, return an empty node.
572 -- It may be that it is not in a package to check, and the node will
573 -- not be added to the tree.
574
575 if Current_Attribute = Empty_Attribute then
576 Attribute := Empty_Node;
577 end if;
578
579 Set_End_Of_Line (Attribute);
580 Set_Previous_Line_Node (Attribute);
581 end Parse_Attribute_Declaration;
582
583 -----------------------------
584 -- Parse_Case_Construction --
585 -----------------------------
586
587 procedure Parse_Case_Construction
588 (In_Tree : Project_Node_Tree_Ref;
589 Case_Construction : out Project_Node_Id;
590 First_Attribute : Attribute_Node_Id;
591 Current_Project : Project_Node_Id;
592 Current_Package : Project_Node_Id;
593 Packages_To_Check : String_List_Access)
594 is
595 Current_Item : Project_Node_Id := Empty_Node;
596 Next_Item : Project_Node_Id := Empty_Node;
597 First_Case_Item : Boolean := True;
598
599 Variable_Location : Source_Ptr := No_Location;
600
601 String_Type : Project_Node_Id := Empty_Node;
602
603 Case_Variable : Project_Node_Id := Empty_Node;
604
605 First_Declarative_Item : Project_Node_Id := Empty_Node;
606
607 First_Choice : Project_Node_Id := Empty_Node;
608
609 When_Others : Boolean := False;
610 -- Set to True when there is a "when others =>" clause
611
612 begin
613 Case_Construction :=
614 Default_Project_Node
615 (Of_Kind => N_Case_Construction, In_Tree => In_Tree);
616 Set_Location_Of (Case_Construction, In_Tree, To => Token_Ptr);
617
618 -- Scan past "case"
619
620 Scan (In_Tree);
621
622 -- Get the switch variable
623
624 Expect (Tok_Identifier, "identifier");
625
626 if Token = Tok_Identifier then
627 Variable_Location := Token_Ptr;
628 Parse_Variable_Reference
629 (In_Tree => In_Tree,
630 Variable => Case_Variable,
631 Current_Project => Current_Project,
632 Current_Package => Current_Package);
633 Set_Case_Variable_Reference_Of
634 (Case_Construction, In_Tree, To => Case_Variable);
635
636 else
637 if Token /= Tok_Is then
638 Scan (In_Tree);
639 end if;
640 end if;
641
642 if Present (Case_Variable) then
643 String_Type := String_Type_Of (Case_Variable, In_Tree);
644
645 if No (String_Type) then
646 Error_Msg ("variable """ &
647 Get_Name_String (Name_Of (Case_Variable, In_Tree)) &
648 """ is not typed",
649 Variable_Location);
650 end if;
651 end if;
652
653 Expect (Tok_Is, "IS");
654
655 if Token = Tok_Is then
656 Set_End_Of_Line (Case_Construction);
657 Set_Previous_Line_Node (Case_Construction);
658 Set_Next_End_Node (Case_Construction);
659
660 -- Scan past "is"
661
662 Scan (In_Tree);
663 end if;
664
665 Start_New_Case_Construction (In_Tree, String_Type);
666
667 When_Loop :
668
669 while Token = Tok_When loop
670
671 if First_Case_Item then
672 Current_Item :=
673 Default_Project_Node
674 (Of_Kind => N_Case_Item, In_Tree => In_Tree);
675 Set_First_Case_Item_Of
676 (Case_Construction, In_Tree, To => Current_Item);
677 First_Case_Item := False;
678
679 else
680 Next_Item :=
681 Default_Project_Node
682 (Of_Kind => N_Case_Item, In_Tree => In_Tree);
683 Set_Next_Case_Item (Current_Item, In_Tree, To => Next_Item);
684 Current_Item := Next_Item;
685 end if;
686
687 Set_Location_Of (Current_Item, In_Tree, To => Token_Ptr);
688
689 -- Scan past "when"
690
691 Scan (In_Tree);
692
693 if Token = Tok_Others then
694 When_Others := True;
695
696 -- Scan past "others"
697
698 Scan (In_Tree);
699
700 Expect (Tok_Arrow, "`=>`");
701 Set_End_Of_Line (Current_Item);
702 Set_Previous_Line_Node (Current_Item);
703
704 -- Empty_Node in Field1 of a Case_Item indicates
705 -- the "when others =>" branch.
706
707 Set_First_Choice_Of (Current_Item, In_Tree, To => Empty_Node);
708
709 Parse_Declarative_Items
710 (In_Tree => In_Tree,
711 Declarations => First_Declarative_Item,
712 In_Zone => In_Case_Construction,
713 First_Attribute => First_Attribute,
714 Current_Project => Current_Project,
715 Current_Package => Current_Package,
716 Packages_To_Check => Packages_To_Check);
717
718 -- "when others =>" must be the last branch, so save the
719 -- Case_Item and exit
720
721 Set_First_Declarative_Item_Of
722 (Current_Item, In_Tree, To => First_Declarative_Item);
723 exit When_Loop;
724
725 else
726 Parse_Choice_List
727 (In_Tree => In_Tree,
728 First_Choice => First_Choice);
729 Set_First_Choice_Of (Current_Item, In_Tree, To => First_Choice);
730
731 Expect (Tok_Arrow, "`=>`");
732 Set_End_Of_Line (Current_Item);
733 Set_Previous_Line_Node (Current_Item);
734
735 Parse_Declarative_Items
736 (In_Tree => In_Tree,
737 Declarations => First_Declarative_Item,
738 In_Zone => In_Case_Construction,
739 First_Attribute => First_Attribute,
740 Current_Project => Current_Project,
741 Current_Package => Current_Package,
742 Packages_To_Check => Packages_To_Check);
743
744 Set_First_Declarative_Item_Of
745 (Current_Item, In_Tree, To => First_Declarative_Item);
746
747 end if;
748 end loop When_Loop;
749
750 End_Case_Construction
751 (Check_All_Labels => not When_Others and not Quiet_Output,
752 Case_Location => Location_Of (Case_Construction, In_Tree));
753
754 Expect (Tok_End, "`END CASE`");
755 Remove_Next_End_Node;
756
757 if Token = Tok_End then
758
759 -- Scan past "end"
760
761 Scan (In_Tree);
762
763 Expect (Tok_Case, "CASE");
764
765 end if;
766
767 -- Scan past "case"
768
769 Scan (In_Tree);
770
771 Expect (Tok_Semicolon, "`;`");
772 Set_Previous_End_Node (Case_Construction);
773
774 end Parse_Case_Construction;
775
776 -----------------------------
777 -- Parse_Declarative_Items --
778 -----------------------------
779
780 procedure Parse_Declarative_Items
781 (In_Tree : Project_Node_Tree_Ref;
782 Declarations : out Project_Node_Id;
783 In_Zone : Zone;
784 First_Attribute : Attribute_Node_Id;
785 Current_Project : Project_Node_Id;
786 Current_Package : Project_Node_Id;
787 Packages_To_Check : String_List_Access)
788 is
789 Current_Declarative_Item : Project_Node_Id := Empty_Node;
790 Next_Declarative_Item : Project_Node_Id := Empty_Node;
791 Current_Declaration : Project_Node_Id := Empty_Node;
792 Item_Location : Source_Ptr := No_Location;
793
794 begin
795 Declarations := Empty_Node;
796
797 loop
798 -- We are always positioned at the token that precedes the first
799 -- token of the declarative element. Scan past it.
800
801 Scan (In_Tree);
802
803 Item_Location := Token_Ptr;
804
805 case Token is
806 when Tok_Identifier =>
807
808 if In_Zone = In_Case_Construction then
809
810 -- Check if the variable has already been declared
811
812 declare
813 The_Variable : Project_Node_Id := Empty_Node;
814
815 begin
816 if Present (Current_Package) then
817 The_Variable :=
818 First_Variable_Of (Current_Package, In_Tree);
819 elsif Present (Current_Project) then
820 The_Variable :=
821 First_Variable_Of (Current_Project, In_Tree);
822 end if;
823
824 while Present (The_Variable)
825 and then Name_Of (The_Variable, In_Tree) /=
826 Token_Name
827 loop
828 The_Variable := Next_Variable (The_Variable, In_Tree);
829 end loop;
830
831 -- It is an error to declare a variable in a case
832 -- construction for the first time.
833
834 if No (The_Variable) then
835 Error_Msg
836 ("a variable cannot be declared " &
837 "for the first time here",
838 Token_Ptr);
839 end if;
840 end;
841 end if;
842
843 Parse_Variable_Declaration
844 (In_Tree,
845 Current_Declaration,
846 Current_Project => Current_Project,
847 Current_Package => Current_Package);
848
849 Set_End_Of_Line (Current_Declaration);
850 Set_Previous_Line_Node (Current_Declaration);
851
852 when Tok_For =>
853
854 Parse_Attribute_Declaration
855 (In_Tree => In_Tree,
856 Attribute => Current_Declaration,
857 First_Attribute => First_Attribute,
858 Current_Project => Current_Project,
859 Current_Package => Current_Package,
860 Packages_To_Check => Packages_To_Check);
861
862 Set_End_Of_Line (Current_Declaration);
863 Set_Previous_Line_Node (Current_Declaration);
864
865 when Tok_Null =>
866
867 Scan (In_Tree); -- past "null"
868
869 when Tok_Package =>
870
871 -- Package declaration
872
873 if In_Zone /= In_Project then
874 Error_Msg ("a package cannot be declared here", Token_Ptr);
875 end if;
876
877 Parse_Package_Declaration
878 (In_Tree => In_Tree,
879 Package_Declaration => Current_Declaration,
880 Current_Project => Current_Project,
881 Packages_To_Check => Packages_To_Check);
882
883 Set_Previous_End_Node (Current_Declaration);
884
885 when Tok_Type =>
886
887 -- Type String Declaration
888
889 if In_Zone /= In_Project then
890 Error_Msg ("a string type cannot be declared here",
891 Token_Ptr);
892 end if;
893
894 Parse_String_Type_Declaration
895 (In_Tree => In_Tree,
896 String_Type => Current_Declaration,
897 Current_Project => Current_Project);
898
899 Set_End_Of_Line (Current_Declaration);
900 Set_Previous_Line_Node (Current_Declaration);
901
902 when Tok_Case =>
903
904 -- Case construction
905
906 Parse_Case_Construction
907 (In_Tree => In_Tree,
908 Case_Construction => Current_Declaration,
909 First_Attribute => First_Attribute,
910 Current_Project => Current_Project,
911 Current_Package => Current_Package,
912 Packages_To_Check => Packages_To_Check);
913
914 Set_Previous_End_Node (Current_Declaration);
915
916 when others =>
917 exit;
918
919 -- We are leaving Parse_Declarative_Items positioned
920 -- at the first token after the list of declarative items.
921 -- It could be "end" (for a project, a package declaration or
922 -- a case construction) or "when" (for a case construction)
923
924 end case;
925
926 Expect (Tok_Semicolon, "`;` after declarative items");
927
928 -- Insert an N_Declarative_Item in the tree, but only if
929 -- Current_Declaration is not an empty node.
930
931 if Present (Current_Declaration) then
932 if No (Current_Declarative_Item) then
933 Current_Declarative_Item :=
934 Default_Project_Node
935 (Of_Kind => N_Declarative_Item, In_Tree => In_Tree);
936 Declarations := Current_Declarative_Item;
937
938 else
939 Next_Declarative_Item :=
940 Default_Project_Node
941 (Of_Kind => N_Declarative_Item, In_Tree => In_Tree);
942 Set_Next_Declarative_Item
943 (Current_Declarative_Item, In_Tree,
944 To => Next_Declarative_Item);
945 Current_Declarative_Item := Next_Declarative_Item;
946 end if;
947
948 Set_Current_Item_Node
949 (Current_Declarative_Item, In_Tree,
950 To => Current_Declaration);
951 Set_Location_Of
952 (Current_Declarative_Item, In_Tree, To => Item_Location);
953 end if;
954 end loop;
955 end Parse_Declarative_Items;
956
957 -------------------------------
958 -- Parse_Package_Declaration --
959 -------------------------------
960
961 procedure Parse_Package_Declaration
962 (In_Tree : Project_Node_Tree_Ref;
963 Package_Declaration : out Project_Node_Id;
964 Current_Project : Project_Node_Id;
965 Packages_To_Check : String_List_Access)
966 is
967 First_Attribute : Attribute_Node_Id := Empty_Attribute;
968 Current_Package : Package_Node_Id := Empty_Package;
969 First_Declarative_Item : Project_Node_Id := Empty_Node;
970
971 Package_Location : constant Source_Ptr := Token_Ptr;
972
973 begin
974 Package_Declaration :=
975 Default_Project_Node
976 (Of_Kind => N_Package_Declaration, In_Tree => In_Tree);
977 Set_Location_Of (Package_Declaration, In_Tree, To => Package_Location);
978
979 -- Scan past "package"
980
981 Scan (In_Tree);
982 Expect (Tok_Identifier, "identifier");
983
984 if Token = Tok_Identifier then
985 Set_Name_Of (Package_Declaration, In_Tree, To => Token_Name);
986
987 Current_Package := Package_Node_Id_Of (Token_Name);
988
989 if Current_Package = Empty_Package then
990 if not Quiet_Output then
991 declare
992 List : constant Strings.String_List := Package_Name_List;
993 Index : Natural;
994 Name : constant String := Get_Name_String (Token_Name);
995
996 begin
997 -- Check for possible misspelling of a known package name
998
999 Index := 0;
1000 loop
1001 if Index >= List'Last then
1002 Index := 0;
1003 exit;
1004 end if;
1005
1006 Index := Index + 1;
1007 exit when
1008 GNAT.Spelling_Checker.Is_Bad_Spelling_Of
1009 (Name, List (Index).all);
1010 end loop;
1011
1012 -- Issue warning(s) in verbose mode or when a possible
1013 -- misspelling has been found.
1014
1015 if Verbose_Mode or else Index /= 0 then
1016 Error_Msg ("?""" &
1017 Get_Name_String
1018 (Name_Of (Package_Declaration, In_Tree)) &
1019 """ is not a known package name",
1020 Token_Ptr);
1021 end if;
1022
1023 if Index /= 0 then
1024 Error_Msg ("\?possible misspelling of """ &
1025 List (Index).all & """",
1026 Token_Ptr);
1027 end if;
1028 end;
1029 end if;
1030
1031 -- Set the package declaration to "ignored" so that it is not
1032 -- processed by Prj.Proc.Process.
1033
1034 Set_Expression_Kind_Of (Package_Declaration, In_Tree, Ignored);
1035
1036 -- Add the unknown package in the list of packages
1037
1038 Add_Unknown_Package (Token_Name, Current_Package);
1039
1040 elsif Current_Package = Unknown_Package then
1041
1042 -- Set the package declaration to "ignored" so that it is not
1043 -- processed by Prj.Proc.Process.
1044
1045 Set_Expression_Kind_Of (Package_Declaration, In_Tree, Ignored);
1046
1047 else
1048 First_Attribute := First_Attribute_Of (Current_Package);
1049 end if;
1050
1051 Set_Package_Id_Of
1052 (Package_Declaration, In_Tree, To => Current_Package);
1053
1054 declare
1055 Current : Project_Node_Id :=
1056 First_Package_Of (Current_Project, In_Tree);
1057
1058 begin
1059 while Present (Current)
1060 and then Name_Of (Current, In_Tree) /= Token_Name
1061 loop
1062 Current := Next_Package_In_Project (Current, In_Tree);
1063 end loop;
1064
1065 if Present (Current) then
1066 Error_Msg
1067 ("package """ &
1068 Get_Name_String (Name_Of (Package_Declaration, In_Tree)) &
1069 """ is declared twice in the same project",
1070 Token_Ptr);
1071
1072 else
1073 -- Add the package to the project list
1074
1075 Set_Next_Package_In_Project
1076 (Package_Declaration, In_Tree,
1077 To => First_Package_Of (Current_Project, In_Tree));
1078 Set_First_Package_Of
1079 (Current_Project, In_Tree, To => Package_Declaration);
1080 end if;
1081 end;
1082
1083 -- Scan past the package name
1084
1085 Scan (In_Tree);
1086 end if;
1087
1088 if Token = Tok_Renames then
1089 if In_Configuration then
1090 Error_Msg
1091 ("no package renames in configuration projects", Token_Ptr);
1092 end if;
1093
1094 -- Scan past "renames"
1095
1096 Scan (In_Tree);
1097
1098 Expect (Tok_Identifier, "identifier");
1099
1100 if Token = Tok_Identifier then
1101 declare
1102 Project_Name : constant Name_Id := Token_Name;
1103
1104 Clause : Project_Node_Id :=
1105 First_With_Clause_Of (Current_Project, In_Tree);
1106 The_Project : Project_Node_Id := Empty_Node;
1107 Extended : constant Project_Node_Id :=
1108 Extended_Project_Of
1109 (Project_Declaration_Of
1110 (Current_Project, In_Tree),
1111 In_Tree);
1112 begin
1113 while Present (Clause) loop
1114 -- Only non limited imported projects may be used in a
1115 -- renames declaration.
1116
1117 The_Project :=
1118 Non_Limited_Project_Node_Of (Clause, In_Tree);
1119 exit when Present (The_Project)
1120 and then Name_Of (The_Project, In_Tree) = Project_Name;
1121 Clause := Next_With_Clause_Of (Clause, In_Tree);
1122 end loop;
1123
1124 if No (Clause) then
1125 -- As we have not found the project in the imports, we check
1126 -- if it's the name of an eventual extended project.
1127
1128 if Present (Extended)
1129 and then Name_Of (Extended, In_Tree) = Project_Name
1130 then
1131 Set_Project_Of_Renamed_Package_Of
1132 (Package_Declaration, In_Tree, To => Extended);
1133 else
1134 Error_Msg_Name_1 := Project_Name;
1135 Error_Msg
1136 ("% is not an imported or extended project", Token_Ptr);
1137 end if;
1138 else
1139 Set_Project_Of_Renamed_Package_Of
1140 (Package_Declaration, In_Tree, To => The_Project);
1141 end if;
1142 end;
1143
1144 Scan (In_Tree);
1145 Expect (Tok_Dot, "`.`");
1146
1147 if Token = Tok_Dot then
1148 Scan (In_Tree);
1149 Expect (Tok_Identifier, "identifier");
1150
1151 if Token = Tok_Identifier then
1152 if Name_Of (Package_Declaration, In_Tree) /= Token_Name then
1153 Error_Msg ("not the same package name", Token_Ptr);
1154 elsif
1155 Present (Project_Of_Renamed_Package_Of
1156 (Package_Declaration, In_Tree))
1157 then
1158 declare
1159 Current : Project_Node_Id :=
1160 First_Package_Of
1161 (Project_Of_Renamed_Package_Of
1162 (Package_Declaration, In_Tree),
1163 In_Tree);
1164
1165 begin
1166 while Present (Current)
1167 and then Name_Of (Current, In_Tree) /= Token_Name
1168 loop
1169 Current :=
1170 Next_Package_In_Project (Current, In_Tree);
1171 end loop;
1172
1173 if No (Current) then
1174 Error_Msg
1175 ("""" &
1176 Get_Name_String (Token_Name) &
1177 """ is not a package declared by the project",
1178 Token_Ptr);
1179 end if;
1180 end;
1181 end if;
1182
1183 Scan (In_Tree);
1184 end if;
1185 end if;
1186 end if;
1187
1188 Expect (Tok_Semicolon, "`;`");
1189 Set_End_Of_Line (Package_Declaration);
1190 Set_Previous_Line_Node (Package_Declaration);
1191
1192 elsif Token = Tok_Is then
1193 Set_End_Of_Line (Package_Declaration);
1194 Set_Previous_Line_Node (Package_Declaration);
1195 Set_Next_End_Node (Package_Declaration);
1196
1197 Parse_Declarative_Items
1198 (In_Tree => In_Tree,
1199 Declarations => First_Declarative_Item,
1200 In_Zone => In_Package,
1201 First_Attribute => First_Attribute,
1202 Current_Project => Current_Project,
1203 Current_Package => Package_Declaration,
1204 Packages_To_Check => Packages_To_Check);
1205
1206 Set_First_Declarative_Item_Of
1207 (Package_Declaration, In_Tree, To => First_Declarative_Item);
1208
1209 Expect (Tok_End, "END");
1210
1211 if Token = Tok_End then
1212
1213 -- Scan past "end"
1214
1215 Scan (In_Tree);
1216 end if;
1217
1218 -- We should have the name of the package after "end"
1219
1220 Expect (Tok_Identifier, "identifier");
1221
1222 if Token = Tok_Identifier
1223 and then Name_Of (Package_Declaration, In_Tree) /= No_Name
1224 and then Token_Name /= Name_Of (Package_Declaration, In_Tree)
1225 then
1226 Error_Msg_Name_1 := Name_Of (Package_Declaration, In_Tree);
1227 Error_Msg ("expected %%", Token_Ptr);
1228 end if;
1229
1230 if Token /= Tok_Semicolon then
1231
1232 -- Scan past the package name
1233
1234 Scan (In_Tree);
1235 end if;
1236
1237 Expect (Tok_Semicolon, "`;`");
1238 Remove_Next_End_Node;
1239
1240 else
1241 Error_Msg ("expected IS or RENAMES", Token_Ptr);
1242 end if;
1243
1244 end Parse_Package_Declaration;
1245
1246 -----------------------------------
1247 -- Parse_String_Type_Declaration --
1248 -----------------------------------
1249
1250 procedure Parse_String_Type_Declaration
1251 (In_Tree : Project_Node_Tree_Ref;
1252 String_Type : out Project_Node_Id;
1253 Current_Project : Project_Node_Id)
1254 is
1255 Current : Project_Node_Id := Empty_Node;
1256 First_String : Project_Node_Id := Empty_Node;
1257
1258 begin
1259 String_Type :=
1260 Default_Project_Node
1261 (Of_Kind => N_String_Type_Declaration, In_Tree => In_Tree);
1262
1263 Set_Location_Of (String_Type, In_Tree, To => Token_Ptr);
1264
1265 -- Scan past "type"
1266
1267 Scan (In_Tree);
1268
1269 Expect (Tok_Identifier, "identifier");
1270
1271 if Token = Tok_Identifier then
1272 Set_Name_Of (String_Type, In_Tree, To => Token_Name);
1273
1274 Current := First_String_Type_Of (Current_Project, In_Tree);
1275 while Present (Current)
1276 and then
1277 Name_Of (Current, In_Tree) /= Token_Name
1278 loop
1279 Current := Next_String_Type (Current, In_Tree);
1280 end loop;
1281
1282 if Present (Current) then
1283 Error_Msg ("duplicate string type name """ &
1284 Get_Name_String (Token_Name) &
1285 """",
1286 Token_Ptr);
1287 else
1288 Current := First_Variable_Of (Current_Project, In_Tree);
1289 while Present (Current)
1290 and then Name_Of (Current, In_Tree) /= Token_Name
1291 loop
1292 Current := Next_Variable (Current, In_Tree);
1293 end loop;
1294
1295 if Present (Current) then
1296 Error_Msg ("""" &
1297 Get_Name_String (Token_Name) &
1298 """ is already a variable name", Token_Ptr);
1299 else
1300 Set_Next_String_Type
1301 (String_Type, In_Tree,
1302 To => First_String_Type_Of (Current_Project, In_Tree));
1303 Set_First_String_Type_Of
1304 (Current_Project, In_Tree, To => String_Type);
1305 end if;
1306 end if;
1307
1308 -- Scan past the name
1309
1310 Scan (In_Tree);
1311 end if;
1312
1313 Expect (Tok_Is, "IS");
1314
1315 if Token = Tok_Is then
1316 Scan (In_Tree);
1317 end if;
1318
1319 Expect (Tok_Left_Paren, "`(`");
1320
1321 if Token = Tok_Left_Paren then
1322 Scan (In_Tree);
1323 end if;
1324
1325 Parse_String_Type_List
1326 (In_Tree => In_Tree, First_String => First_String);
1327 Set_First_Literal_String (String_Type, In_Tree, To => First_String);
1328
1329 Expect (Tok_Right_Paren, "`)`");
1330
1331 if Token = Tok_Right_Paren then
1332 Scan (In_Tree);
1333 end if;
1334
1335 end Parse_String_Type_Declaration;
1336
1337 --------------------------------
1338 -- Parse_Variable_Declaration --
1339 --------------------------------
1340
1341 procedure Parse_Variable_Declaration
1342 (In_Tree : Project_Node_Tree_Ref;
1343 Variable : out Project_Node_Id;
1344 Current_Project : Project_Node_Id;
1345 Current_Package : Project_Node_Id)
1346 is
1347 Expression_Location : Source_Ptr;
1348 String_Type_Name : Name_Id := No_Name;
1349 Project_String_Type_Name : Name_Id := No_Name;
1350 Type_Location : Source_Ptr := No_Location;
1351 Project_Location : Source_Ptr := No_Location;
1352 Expression : Project_Node_Id := Empty_Node;
1353 Variable_Name : constant Name_Id := Token_Name;
1354 OK : Boolean := True;
1355
1356 begin
1357 Variable :=
1358 Default_Project_Node
1359 (Of_Kind => N_Variable_Declaration, In_Tree => In_Tree);
1360 Set_Name_Of (Variable, In_Tree, To => Variable_Name);
1361 Set_Location_Of (Variable, In_Tree, To => Token_Ptr);
1362
1363 -- Scan past the variable name
1364
1365 Scan (In_Tree);
1366
1367 if Token = Tok_Colon then
1368
1369 -- Typed string variable declaration
1370
1371 Scan (In_Tree);
1372 Set_Kind_Of (Variable, In_Tree, N_Typed_Variable_Declaration);
1373 Expect (Tok_Identifier, "identifier");
1374
1375 OK := Token = Tok_Identifier;
1376
1377 if OK then
1378 String_Type_Name := Token_Name;
1379 Type_Location := Token_Ptr;
1380 Scan (In_Tree);
1381
1382 if Token = Tok_Dot then
1383 Project_String_Type_Name := String_Type_Name;
1384 Project_Location := Type_Location;
1385
1386 -- Scan past the dot
1387
1388 Scan (In_Tree);
1389 Expect (Tok_Identifier, "identifier");
1390
1391 if Token = Tok_Identifier then
1392 String_Type_Name := Token_Name;
1393 Type_Location := Token_Ptr;
1394 Scan (In_Tree);
1395 else
1396 OK := False;
1397 end if;
1398 end if;
1399
1400 if OK then
1401 declare
1402 Proj : Project_Node_Id := Current_Project;
1403 Current : Project_Node_Id := Empty_Node;
1404
1405 begin
1406 if Project_String_Type_Name /= No_Name then
1407 declare
1408 The_Project_Name_And_Node : constant
1409 Tree_Private_Part.Project_Name_And_Node :=
1410 Tree_Private_Part.Projects_Htable.Get
1411 (In_Tree.Projects_HT, Project_String_Type_Name);
1412
1413 use Tree_Private_Part;
1414
1415 begin
1416 if The_Project_Name_And_Node =
1417 Tree_Private_Part.No_Project_Name_And_Node
1418 then
1419 Error_Msg ("unknown project """ &
1420 Get_Name_String
1421 (Project_String_Type_Name) &
1422 """",
1423 Project_Location);
1424 Current := Empty_Node;
1425 else
1426 Current :=
1427 First_String_Type_Of
1428 (The_Project_Name_And_Node.Node, In_Tree);
1429 while
1430 Present (Current)
1431 and then
1432 Name_Of (Current, In_Tree) /= String_Type_Name
1433 loop
1434 Current := Next_String_Type (Current, In_Tree);
1435 end loop;
1436 end if;
1437 end;
1438
1439 else
1440 -- Look for a string type with the correct name in this
1441 -- project or in any of its ancestors.
1442
1443 loop
1444 Current :=
1445 First_String_Type_Of (Proj, In_Tree);
1446 while
1447 Present (Current)
1448 and then
1449 Name_Of (Current, In_Tree) /= String_Type_Name
1450 loop
1451 Current := Next_String_Type (Current, In_Tree);
1452 end loop;
1453
1454 exit when Present (Current);
1455
1456 Proj := Parent_Project_Of (Proj, In_Tree);
1457 exit when No (Proj);
1458 end loop;
1459 end if;
1460
1461 if No (Current) then
1462 Error_Msg ("unknown string type """ &
1463 Get_Name_String (String_Type_Name) &
1464 """",
1465 Type_Location);
1466 OK := False;
1467
1468 else
1469 Set_String_Type_Of
1470 (Variable, In_Tree, To => Current);
1471 end if;
1472 end;
1473 end if;
1474 end if;
1475 end if;
1476
1477 Expect (Tok_Colon_Equal, "`:=`");
1478
1479 OK := OK and (Token = Tok_Colon_Equal);
1480
1481 if Token = Tok_Colon_Equal then
1482 Scan (In_Tree);
1483 end if;
1484
1485 -- Get the single string or string list value
1486
1487 Expression_Location := Token_Ptr;
1488
1489 Parse_Expression
1490 (In_Tree => In_Tree,
1491 Expression => Expression,
1492 Current_Project => Current_Project,
1493 Current_Package => Current_Package,
1494 Optional_Index => False);
1495 Set_Expression_Of (Variable, In_Tree, To => Expression);
1496
1497 if Present (Expression) then
1498 -- A typed string must have a single string value, not a list
1499
1500 if Kind_Of (Variable, In_Tree) = N_Typed_Variable_Declaration
1501 and then Expression_Kind_Of (Expression, In_Tree) = List
1502 then
1503 Error_Msg
1504 ("expression must be a single string", Expression_Location);
1505 end if;
1506
1507 Set_Expression_Kind_Of
1508 (Variable, In_Tree,
1509 To => Expression_Kind_Of (Expression, In_Tree));
1510 end if;
1511
1512 if OK then
1513 declare
1514 The_Variable : Project_Node_Id := Empty_Node;
1515
1516 begin
1517 if Present (Current_Package) then
1518 The_Variable := First_Variable_Of (Current_Package, In_Tree);
1519 elsif Present (Current_Project) then
1520 The_Variable := First_Variable_Of (Current_Project, In_Tree);
1521 end if;
1522
1523 while Present (The_Variable)
1524 and then Name_Of (The_Variable, In_Tree) /= Variable_Name
1525 loop
1526 The_Variable := Next_Variable (The_Variable, In_Tree);
1527 end loop;
1528
1529 if No (The_Variable) then
1530 if Present (Current_Package) then
1531 Set_Next_Variable
1532 (Variable, In_Tree,
1533 To => First_Variable_Of (Current_Package, In_Tree));
1534 Set_First_Variable_Of
1535 (Current_Package, In_Tree, To => Variable);
1536
1537 elsif Present (Current_Project) then
1538 Set_Next_Variable
1539 (Variable, In_Tree,
1540 To => First_Variable_Of (Current_Project, In_Tree));
1541 Set_First_Variable_Of
1542 (Current_Project, In_Tree, To => Variable);
1543 end if;
1544
1545 else
1546 if Expression_Kind_Of (Variable, In_Tree) /= Undefined then
1547 if Expression_Kind_Of (The_Variable, In_Tree) =
1548 Undefined
1549 then
1550 Set_Expression_Kind_Of
1551 (The_Variable, In_Tree,
1552 To => Expression_Kind_Of (Variable, In_Tree));
1553
1554 else
1555 if Expression_Kind_Of (The_Variable, In_Tree) /=
1556 Expression_Kind_Of (Variable, In_Tree)
1557 then
1558 Error_Msg ("wrong expression kind for variable """ &
1559 Get_Name_String
1560 (Name_Of (The_Variable, In_Tree)) &
1561 """",
1562 Expression_Location);
1563 end if;
1564 end if;
1565 end if;
1566 end if;
1567 end;
1568 end if;
1569 end Parse_Variable_Declaration;
1570
1571 end Prj.Dect;
Mirror of the offical gcc git repository hosted at gcc.gnu.org