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