PR target/16201
[official-gcc.git] / gcc / ada / prj-tree.adb
blob2a67b57c5b122dfcdd201f67da2ea07303f2d1a0
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . T R E E --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
21 -- --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
25 ------------------------------------------------------------------------------
27 with Prj.Err;
29 package body Prj.Tree is
31 Node_With_Comments : constant array (Project_Node_Kind) of Boolean :=
32 (N_Project => True,
33 N_With_Clause => True,
34 N_Project_Declaration => False,
35 N_Declarative_Item => False,
36 N_Package_Declaration => True,
37 N_String_Type_Declaration => True,
38 N_Literal_String => False,
39 N_Attribute_Declaration => True,
40 N_Typed_Variable_Declaration => True,
41 N_Variable_Declaration => True,
42 N_Expression => False,
43 N_Term => False,
44 N_Literal_String_List => False,
45 N_Variable_Reference => False,
46 N_External_Value => False,
47 N_Attribute_Reference => False,
48 N_Case_Construction => True,
49 N_Case_Item => True,
50 N_Comment_Zones => True,
51 N_Comment => True);
52 -- Indicates the kinds of node that may have associated comments
54 package Next_End_Nodes is new Table.Table
55 (Table_Component_Type => Project_Node_Id,
56 Table_Index_Type => Natural,
57 Table_Low_Bound => 1,
58 Table_Initial => 10,
59 Table_Increment => 100,
60 Table_Name => "Next_End_Nodes");
61 -- A stack of nodes to indicates to what node the next "end" is associated
63 use Tree_Private_Part;
65 End_Of_Line_Node : Project_Node_Id := Empty_Node;
66 -- The node an end of line comment may be associated with
68 Previous_Line_Node : Project_Node_Id := Empty_Node;
69 -- The node an immediately following comment may be associated with
71 Previous_End_Node : Project_Node_Id := Empty_Node;
72 -- The node comments immediately following an "end" line may be
73 -- associated with.
75 Unkept_Comments : Boolean := False;
76 -- Set to True when some comments may not be associated with any node
78 function Comment_Zones_Of
79 (Node : Project_Node_Id) return Project_Node_Id;
80 -- Returns the ID of the N_Comment_Zones node associated with node Node.
81 -- If there is not already an N_Comment_Zones node, create one and
82 -- associate it with node Node.
84 ------------------
85 -- Add_Comments --
86 ------------------
88 procedure Add_Comments (To : Project_Node_Id; Where : Comment_Location) is
89 Zone : Project_Node_Id := Empty_Node;
90 Previous : Project_Node_Id := Empty_Node;
92 begin
93 pragma Assert
94 (To /= Empty_Node
95 and then
96 Project_Nodes.Table (To).Kind /= N_Comment);
98 Zone := Project_Nodes.Table (To).Comments;
100 if Zone = Empty_Node then
102 -- Create new N_Comment_Zones node
104 Project_Nodes.Increment_Last;
105 Project_Nodes.Table (Project_Nodes.Last) :=
106 (Kind => N_Comment_Zones,
107 Expr_Kind => Undefined,
108 Location => No_Location,
109 Directory => No_Name,
110 Variables => Empty_Node,
111 Packages => Empty_Node,
112 Pkg_Id => Empty_Package,
113 Name => No_Name,
114 Src_Index => 0,
115 Path_Name => No_Name,
116 Value => No_Name,
117 Field1 => Empty_Node,
118 Field2 => Empty_Node,
119 Field3 => Empty_Node,
120 Flag1 => False,
121 Flag2 => False,
122 Comments => Empty_Node);
124 Zone := Project_Nodes.Last;
125 Project_Nodes.Table (To).Comments := Zone;
126 end if;
128 if Where = End_Of_Line then
129 Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
131 else
132 -- Get each comments in the Comments table and link them to node To
134 for J in 1 .. Comments.Last loop
136 -- Create new N_Comment node
138 if (Where = After or else Where = After_End) and then
139 Token /= Tok_EOF and then
140 Comments.Table (J).Follows_Empty_Line
141 then
142 Comments.Table (1 .. Comments.Last - J + 1) :=
143 Comments.Table (J .. Comments.Last);
144 Comments.Set_Last (Comments.Last - J + 1);
145 return;
146 end if;
148 Project_Nodes.Increment_Last;
149 Project_Nodes.Table (Project_Nodes.Last) :=
150 (Kind => N_Comment,
151 Expr_Kind => Undefined,
152 Flag1 => Comments.Table (J).Follows_Empty_Line,
153 Flag2 =>
154 Comments.Table (J).Is_Followed_By_Empty_Line,
155 Location => No_Location,
156 Directory => No_Name,
157 Variables => Empty_Node,
158 Packages => Empty_Node,
159 Pkg_Id => Empty_Package,
160 Name => No_Name,
161 Src_Index => 0,
162 Path_Name => No_Name,
163 Value => Comments.Table (J).Value,
164 Field1 => Empty_Node,
165 Field2 => Empty_Node,
166 Field3 => Empty_Node,
167 Comments => Empty_Node);
169 -- If this is the first comment, put it in the right field of
170 -- the node Zone.
172 if Previous = Empty_Node then
173 case Where is
174 when Before =>
175 Project_Nodes.Table (Zone).Field1 := Project_Nodes.Last;
177 when After =>
178 Project_Nodes.Table (Zone).Field2 := Project_Nodes.Last;
180 when Before_End =>
181 Project_Nodes.Table (Zone).Field3 := Project_Nodes.Last;
183 when After_End =>
184 Project_Nodes.Table (Zone).Comments := Project_Nodes.Last;
186 when End_Of_Line =>
187 null;
188 end case;
190 else
191 -- When it is not the first, link it to the previous one
193 Project_Nodes.Table (Previous).Comments := Project_Nodes.Last;
194 end if;
196 -- This node becomes the previous one for the next comment, if
197 -- there is one.
199 Previous := Project_Nodes.Last;
200 end loop;
201 end if;
203 -- Empty the Comments table, so that there is no risk to link the same
204 -- comments to another node.
206 Comments.Set_Last (0);
207 end Add_Comments;
209 --------------------------------
210 -- Associative_Array_Index_Of --
211 --------------------------------
213 function Associative_Array_Index_Of
214 (Node : Project_Node_Id) return Name_Id
216 begin
217 pragma Assert
218 (Node /= Empty_Node
219 and then
220 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
221 or else
222 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
223 return Project_Nodes.Table (Node).Value;
224 end Associative_Array_Index_Of;
226 ----------------------------
227 -- Associative_Package_Of --
228 ----------------------------
230 function Associative_Package_Of
231 (Node : Project_Node_Id) return Project_Node_Id
233 begin
234 pragma Assert
235 (Node /= Empty_Node
236 and then
237 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
238 return Project_Nodes.Table (Node).Field3;
239 end Associative_Package_Of;
241 ----------------------------
242 -- Associative_Project_Of --
243 ----------------------------
245 function Associative_Project_Of
246 (Node : Project_Node_Id) return Project_Node_Id
248 begin
249 pragma Assert
250 (Node /= Empty_Node
251 and then
252 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
253 return Project_Nodes.Table (Node).Field2;
254 end Associative_Project_Of;
256 ----------------------
257 -- Case_Insensitive --
258 ----------------------
260 function Case_Insensitive (Node : Project_Node_Id) return Boolean is
261 begin
262 pragma Assert
263 (Node /= Empty_Node
264 and then
265 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
266 or else
267 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
268 return Project_Nodes.Table (Node).Flag1;
269 end Case_Insensitive;
271 --------------------------------
272 -- Case_Variable_Reference_Of --
273 --------------------------------
275 function Case_Variable_Reference_Of
276 (Node : Project_Node_Id) return Project_Node_Id
278 begin
279 pragma Assert
280 (Node /= Empty_Node
281 and then
282 Project_Nodes.Table (Node).Kind = N_Case_Construction);
283 return Project_Nodes.Table (Node).Field1;
284 end Case_Variable_Reference_Of;
286 ----------------------
287 -- Comment_Zones_Of --
288 ----------------------
290 function Comment_Zones_Of
291 (Node : Project_Node_Id) return Project_Node_Id
293 Zone : Project_Node_Id;
295 begin
296 pragma Assert (Node /= Empty_Node);
297 Zone := Project_Nodes.Table (Node).Comments;
299 -- If there is not already an N_Comment_Zones associated, create a new
300 -- one and associate it with node Node.
302 if Zone = Empty_Node then
303 Project_Nodes.Increment_Last;
304 Zone := Project_Nodes.Last;
305 Project_Nodes.Table (Zone) :=
306 (Kind => N_Comment_Zones,
307 Location => No_Location,
308 Directory => No_Name,
309 Expr_Kind => Undefined,
310 Variables => Empty_Node,
311 Packages => Empty_Node,
312 Pkg_Id => Empty_Package,
313 Name => No_Name,
314 Src_Index => 0,
315 Path_Name => No_Name,
316 Value => No_Name,
317 Field1 => Empty_Node,
318 Field2 => Empty_Node,
319 Field3 => Empty_Node,
320 Flag1 => False,
321 Flag2 => False,
322 Comments => Empty_Node);
323 Project_Nodes.Table (Node).Comments := Zone;
324 end if;
326 return Zone;
327 end Comment_Zones_Of;
329 -----------------------
330 -- Current_Item_Node --
331 -----------------------
333 function Current_Item_Node
334 (Node : Project_Node_Id) return Project_Node_Id
336 begin
337 pragma Assert
338 (Node /= Empty_Node
339 and then
340 Project_Nodes.Table (Node).Kind = N_Declarative_Item);
341 return Project_Nodes.Table (Node).Field1;
342 end Current_Item_Node;
344 ------------------
345 -- Current_Term --
346 ------------------
348 function Current_Term
349 (Node : Project_Node_Id) return Project_Node_Id
351 begin
352 pragma Assert
353 (Node /= Empty_Node
354 and then
355 Project_Nodes.Table (Node).Kind = N_Term);
356 return Project_Nodes.Table (Node).Field1;
357 end Current_Term;
359 --------------------------
360 -- Default_Project_Node --
361 --------------------------
363 function Default_Project_Node
364 (Of_Kind : Project_Node_Kind;
365 And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id
367 Result : Project_Node_Id;
368 Zone : Project_Node_Id;
369 Previous : Project_Node_Id;
371 begin
372 -- Create new node with specified kind and expression kind
374 Project_Nodes.Increment_Last;
375 Project_Nodes.Table (Project_Nodes.Last) :=
376 (Kind => Of_Kind,
377 Location => No_Location,
378 Directory => No_Name,
379 Expr_Kind => And_Expr_Kind,
380 Variables => Empty_Node,
381 Packages => Empty_Node,
382 Pkg_Id => Empty_Package,
383 Name => No_Name,
384 Src_Index => 0,
385 Path_Name => No_Name,
386 Value => No_Name,
387 Field1 => Empty_Node,
388 Field2 => Empty_Node,
389 Field3 => Empty_Node,
390 Flag1 => False,
391 Flag2 => False,
392 Comments => Empty_Node);
394 -- Save the new node for the returned value
396 Result := Project_Nodes.Last;
398 if Comments.Last > 0 then
400 -- If this is not a node with comments, then set the flag
402 if not Node_With_Comments (Of_Kind) then
403 Unkept_Comments := True;
405 elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then
407 Project_Nodes.Increment_Last;
408 Project_Nodes.Table (Project_Nodes.Last) :=
409 (Kind => N_Comment_Zones,
410 Expr_Kind => Undefined,
411 Location => No_Location,
412 Directory => No_Name,
413 Variables => Empty_Node,
414 Packages => Empty_Node,
415 Pkg_Id => Empty_Package,
416 Name => No_Name,
417 Src_Index => 0,
418 Path_Name => No_Name,
419 Value => No_Name,
420 Field1 => Empty_Node,
421 Field2 => Empty_Node,
422 Field3 => Empty_Node,
423 Flag1 => False,
424 Flag2 => False,
425 Comments => Empty_Node);
427 Zone := Project_Nodes.Last;
428 Project_Nodes.Table (Result).Comments := Zone;
429 Previous := Empty_Node;
431 for J in 1 .. Comments.Last loop
433 -- Create a new N_Comment node
435 Project_Nodes.Increment_Last;
436 Project_Nodes.Table (Project_Nodes.Last) :=
437 (Kind => N_Comment,
438 Expr_Kind => Undefined,
439 Flag1 => Comments.Table (J).Follows_Empty_Line,
440 Flag2 =>
441 Comments.Table (J).Is_Followed_By_Empty_Line,
442 Location => No_Location,
443 Directory => No_Name,
444 Variables => Empty_Node,
445 Packages => Empty_Node,
446 Pkg_Id => Empty_Package,
447 Name => No_Name,
448 Src_Index => 0,
449 Path_Name => No_Name,
450 Value => Comments.Table (J).Value,
451 Field1 => Empty_Node,
452 Field2 => Empty_Node,
453 Field3 => Empty_Node,
454 Comments => Empty_Node);
456 -- Link it to the N_Comment_Zones node, if it is the first,
457 -- otherwise to the previous one.
459 if Previous = Empty_Node then
460 Project_Nodes.Table (Zone).Field1 := Project_Nodes.Last;
462 else
463 Project_Nodes.Table (Previous).Comments :=
464 Project_Nodes.Last;
465 end if;
467 -- This new node will be the previous one for the next
468 -- N_Comment node, if there is one.
470 Previous := Project_Nodes.Last;
471 end loop;
473 -- Empty the Comments table after all comments have been processed
475 Comments.Set_Last (0);
476 end if;
477 end if;
479 return Result;
480 end Default_Project_Node;
482 ------------------
483 -- Directory_Of --
484 ------------------
486 function Directory_Of (Node : Project_Node_Id) return Name_Id is
487 begin
488 pragma Assert
489 (Node /= Empty_Node
490 and then
491 Project_Nodes.Table (Node).Kind = N_Project);
492 return Project_Nodes.Table (Node).Directory;
493 end Directory_Of;
495 -------------------------
496 -- End_Of_Line_Comment --
497 -------------------------
499 function End_Of_Line_Comment (Node : Project_Node_Id) return Name_Id is
500 Zone : Project_Node_Id := Empty_Node;
502 begin
503 pragma Assert (Node /= Empty_Node);
504 Zone := Project_Nodes.Table (Node).Comments;
506 if Zone = Empty_Node then
507 return No_Name;
508 else
509 return Project_Nodes.Table (Zone).Value;
510 end if;
511 end End_Of_Line_Comment;
513 ------------------------
514 -- Expression_Kind_Of --
515 ------------------------
517 function Expression_Kind_Of (Node : Project_Node_Id) return Variable_Kind is
518 begin
519 pragma Assert
520 (Node /= Empty_Node
521 and then
522 (Project_Nodes.Table (Node).Kind = N_Literal_String
523 or else
524 Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
525 or else
526 Project_Nodes.Table (Node).Kind = N_Variable_Declaration
527 or else
528 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
529 or else
530 Project_Nodes.Table (Node).Kind = N_Package_Declaration
531 or else
532 Project_Nodes.Table (Node).Kind = N_Expression
533 or else
534 Project_Nodes.Table (Node).Kind = N_Term
535 or else
536 Project_Nodes.Table (Node).Kind = N_Variable_Reference
537 or else
538 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
540 return Project_Nodes.Table (Node).Expr_Kind;
541 end Expression_Kind_Of;
543 -------------------
544 -- Expression_Of --
545 -------------------
547 function Expression_Of
548 (Node : Project_Node_Id) return Project_Node_Id
550 begin
551 pragma Assert
552 (Node /= Empty_Node
553 and then
554 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
555 or else
556 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
557 or else
558 Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
560 return Project_Nodes.Table (Node).Field1;
561 end Expression_Of;
563 -------------------------
564 -- Extended_Project_Of --
565 -------------------------
567 function Extended_Project_Of
568 (Node : Project_Node_Id) return Project_Node_Id
570 begin
571 pragma Assert
572 (Node /= Empty_Node
573 and then
574 Project_Nodes.Table (Node).Kind = N_Project_Declaration);
575 return Project_Nodes.Table (Node).Field2;
576 end Extended_Project_Of;
578 ------------------------------
579 -- Extended_Project_Path_Of --
580 ------------------------------
582 function Extended_Project_Path_Of
583 (Node : Project_Node_Id) return Name_Id
585 begin
586 pragma Assert
587 (Node /= Empty_Node
588 and then
589 Project_Nodes.Table (Node).Kind = N_Project);
590 return Project_Nodes.Table (Node).Value;
591 end Extended_Project_Path_Of;
593 --------------------------
594 -- Extending_Project_Of --
595 --------------------------
596 function Extending_Project_Of
597 (Node : Project_Node_Id) return Project_Node_Id
599 begin
600 pragma Assert
601 (Node /= Empty_Node
602 and then
603 Project_Nodes.Table (Node).Kind = N_Project_Declaration);
604 return Project_Nodes.Table (Node).Field3;
605 end Extending_Project_Of;
607 ---------------------------
608 -- External_Reference_Of --
609 ---------------------------
611 function External_Reference_Of
612 (Node : Project_Node_Id) return Project_Node_Id
614 begin
615 pragma Assert
616 (Node /= Empty_Node
617 and then
618 Project_Nodes.Table (Node).Kind = N_External_Value);
619 return Project_Nodes.Table (Node).Field1;
620 end External_Reference_Of;
622 -------------------------
623 -- External_Default_Of --
624 -------------------------
626 function External_Default_Of
627 (Node : Project_Node_Id)
628 return Project_Node_Id
630 begin
631 pragma Assert
632 (Node /= Empty_Node
633 and then
634 Project_Nodes.Table (Node).Kind = N_External_Value);
635 return Project_Nodes.Table (Node).Field2;
636 end External_Default_Of;
638 ------------------------
639 -- First_Case_Item_Of --
640 ------------------------
642 function First_Case_Item_Of
643 (Node : Project_Node_Id) return Project_Node_Id
645 begin
646 pragma Assert
647 (Node /= Empty_Node
648 and then
649 Project_Nodes.Table (Node).Kind = N_Case_Construction);
650 return Project_Nodes.Table (Node).Field2;
651 end First_Case_Item_Of;
653 ---------------------
654 -- First_Choice_Of --
655 ---------------------
657 function First_Choice_Of
658 (Node : Project_Node_Id)
659 return Project_Node_Id
661 begin
662 pragma Assert
663 (Node /= Empty_Node
664 and then
665 Project_Nodes.Table (Node).Kind = N_Case_Item);
666 return Project_Nodes.Table (Node).Field1;
667 end First_Choice_Of;
669 -------------------------
670 -- First_Comment_After --
671 -------------------------
673 function First_Comment_After
674 (Node : Project_Node_Id) return Project_Node_Id
676 Zone : Project_Node_Id := Empty_Node;
677 begin
678 pragma Assert (Node /= Empty_Node);
679 Zone := Project_Nodes.Table (Node).Comments;
681 if Zone = Empty_Node then
682 return Empty_Node;
684 else
685 return Project_Nodes.Table (Zone).Field2;
686 end if;
687 end First_Comment_After;
689 -----------------------------
690 -- First_Comment_After_End --
691 -----------------------------
693 function First_Comment_After_End
694 (Node : Project_Node_Id)
695 return Project_Node_Id
697 Zone : Project_Node_Id := Empty_Node;
699 begin
700 pragma Assert (Node /= Empty_Node);
701 Zone := Project_Nodes.Table (Node).Comments;
703 if Zone = Empty_Node then
704 return Empty_Node;
706 else
707 return Project_Nodes.Table (Zone).Comments;
708 end if;
709 end First_Comment_After_End;
711 --------------------------
712 -- First_Comment_Before --
713 --------------------------
715 function First_Comment_Before
716 (Node : Project_Node_Id) return Project_Node_Id
718 Zone : Project_Node_Id := Empty_Node;
720 begin
721 pragma Assert (Node /= Empty_Node);
722 Zone := Project_Nodes.Table (Node).Comments;
724 if Zone = Empty_Node then
725 return Empty_Node;
727 else
728 return Project_Nodes.Table (Zone).Field1;
729 end if;
730 end First_Comment_Before;
732 ------------------------------
733 -- First_Comment_Before_End --
734 ------------------------------
736 function First_Comment_Before_End
737 (Node : Project_Node_Id) return Project_Node_Id
739 Zone : Project_Node_Id := Empty_Node;
741 begin
742 pragma Assert (Node /= Empty_Node);
743 Zone := Project_Nodes.Table (Node).Comments;
745 if Zone = Empty_Node then
746 return Empty_Node;
748 else
749 return Project_Nodes.Table (Zone).Field3;
750 end if;
751 end First_Comment_Before_End;
753 -------------------------------
754 -- First_Declarative_Item_Of --
755 -------------------------------
757 function First_Declarative_Item_Of
758 (Node : Project_Node_Id) return Project_Node_Id
760 begin
761 pragma Assert
762 (Node /= Empty_Node
763 and then
764 (Project_Nodes.Table (Node).Kind = N_Project_Declaration
765 or else
766 Project_Nodes.Table (Node).Kind = N_Case_Item
767 or else
768 Project_Nodes.Table (Node).Kind = N_Package_Declaration));
770 if Project_Nodes.Table (Node).Kind = N_Project_Declaration then
771 return Project_Nodes.Table (Node).Field1;
772 else
773 return Project_Nodes.Table (Node).Field2;
774 end if;
775 end First_Declarative_Item_Of;
777 ------------------------------
778 -- First_Expression_In_List --
779 ------------------------------
781 function First_Expression_In_List
782 (Node : Project_Node_Id) return Project_Node_Id
784 begin
785 pragma Assert
786 (Node /= Empty_Node
787 and then
788 Project_Nodes.Table (Node).Kind = N_Literal_String_List);
789 return Project_Nodes.Table (Node).Field1;
790 end First_Expression_In_List;
792 --------------------------
793 -- First_Literal_String --
794 --------------------------
796 function First_Literal_String
797 (Node : Project_Node_Id) return Project_Node_Id
799 begin
800 pragma Assert
801 (Node /= Empty_Node
802 and then
803 Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
804 return Project_Nodes.Table (Node).Field1;
805 end First_Literal_String;
807 ----------------------
808 -- First_Package_Of --
809 ----------------------
811 function First_Package_Of
812 (Node : Project_Node_Id) return Package_Declaration_Id
814 begin
815 pragma Assert
816 (Node /= Empty_Node
817 and then
818 Project_Nodes.Table (Node).Kind = N_Project);
819 return Project_Nodes.Table (Node).Packages;
820 end First_Package_Of;
822 --------------------------
823 -- First_String_Type_Of --
824 --------------------------
826 function First_String_Type_Of
827 (Node : Project_Node_Id) return Project_Node_Id
829 begin
830 pragma Assert
831 (Node /= Empty_Node
832 and then
833 Project_Nodes.Table (Node).Kind = N_Project);
834 return Project_Nodes.Table (Node).Field3;
835 end First_String_Type_Of;
837 ----------------
838 -- First_Term --
839 ----------------
841 function First_Term
842 (Node : Project_Node_Id) return Project_Node_Id
844 begin
845 pragma Assert
846 (Node /= Empty_Node
847 and then
848 Project_Nodes.Table (Node).Kind = N_Expression);
849 return Project_Nodes.Table (Node).Field1;
850 end First_Term;
852 -----------------------
853 -- First_Variable_Of --
854 -----------------------
856 function First_Variable_Of
857 (Node : Project_Node_Id) return Variable_Node_Id
859 begin
860 pragma Assert
861 (Node /= Empty_Node
862 and then
863 (Project_Nodes.Table (Node).Kind = N_Project
864 or else
865 Project_Nodes.Table (Node).Kind = N_Package_Declaration));
867 return Project_Nodes.Table (Node).Variables;
868 end First_Variable_Of;
870 --------------------------
871 -- First_With_Clause_Of --
872 --------------------------
874 function First_With_Clause_Of
875 (Node : Project_Node_Id) return Project_Node_Id
877 begin
878 pragma Assert
879 (Node /= Empty_Node
880 and then
881 Project_Nodes.Table (Node).Kind = N_Project);
882 return Project_Nodes.Table (Node).Field1;
883 end First_With_Clause_Of;
885 ------------------------
886 -- Follows_Empty_Line --
887 ------------------------
889 function Follows_Empty_Line (Node : Project_Node_Id) return Boolean is
890 begin
891 pragma Assert
892 (Node /= Empty_Node
893 and then
894 Project_Nodes.Table (Node).Kind = N_Comment);
895 return Project_Nodes.Table (Node).Flag1;
896 end Follows_Empty_Line;
898 ----------
899 -- Hash --
900 ----------
902 function Hash (N : Project_Node_Id) return Header_Num is
903 begin
904 return Header_Num (N mod Project_Node_Id (Header_Num'Last));
905 end Hash;
907 ----------------
908 -- Initialize --
909 ----------------
911 procedure Initialize is
912 begin
913 Project_Nodes.Set_Last (Empty_Node);
914 Projects_Htable.Reset;
915 end Initialize;
917 -------------------------------
918 -- Is_Followed_By_Empty_Line --
919 -------------------------------
921 function Is_Followed_By_Empty_Line
922 (Node : Project_Node_Id) return Boolean
924 begin
925 pragma Assert
926 (Node /= Empty_Node
927 and then
928 Project_Nodes.Table (Node).Kind = N_Comment);
929 return Project_Nodes.Table (Node).Flag2;
930 end Is_Followed_By_Empty_Line;
932 ----------------------
933 -- Is_Extending_All --
934 ----------------------
936 function Is_Extending_All (Node : Project_Node_Id) return Boolean is
937 begin
938 pragma Assert
939 (Node /= Empty_Node
940 and then
941 (Project_Nodes.Table (Node).Kind = N_Project
942 or else
943 Project_Nodes.Table (Node).Kind = N_With_Clause));
944 return Project_Nodes.Table (Node).Flag2;
945 end Is_Extending_All;
947 -------------------------------------
948 -- Imported_Or_Extended_Project_Of --
949 -------------------------------------
951 function Imported_Or_Extended_Project_Of
952 (Project : Project_Node_Id;
953 With_Name : Name_Id) return Project_Node_Id
955 With_Clause : Project_Node_Id := First_With_Clause_Of (Project);
956 Result : Project_Node_Id := Empty_Node;
958 begin
959 -- First check all the imported projects
961 while With_Clause /= Empty_Node loop
963 -- Only non limited imported project may be used as prefix
964 -- of variable or attributes.
966 Result := Non_Limited_Project_Node_Of (With_Clause);
967 exit when Result /= Empty_Node and then Name_Of (Result) = With_Name;
968 With_Clause := Next_With_Clause_Of (With_Clause);
969 end loop;
971 -- If it is not an imported project, it might be the imported project
973 if With_Clause = Empty_Node then
974 Result := Extended_Project_Of (Project_Declaration_Of (Project));
976 if Result /= Empty_Node
977 and then Name_Of (Result) /= With_Name
978 then
979 Result := Empty_Node;
980 end if;
981 end if;
983 return Result;
984 end Imported_Or_Extended_Project_Of;
986 -------------
987 -- Kind_Of --
988 -------------
990 function Kind_Of (Node : Project_Node_Id) return Project_Node_Kind is
991 begin
992 pragma Assert (Node /= Empty_Node);
993 return Project_Nodes.Table (Node).Kind;
994 end Kind_Of;
996 -----------------
997 -- Location_Of --
998 -----------------
1000 function Location_Of (Node : Project_Node_Id) return Source_Ptr is
1001 begin
1002 pragma Assert (Node /= Empty_Node);
1003 return Project_Nodes.Table (Node).Location;
1004 end Location_Of;
1006 -------------
1007 -- Name_Of --
1008 -------------
1010 function Name_Of (Node : Project_Node_Id) return Name_Id is
1011 begin
1012 pragma Assert (Node /= Empty_Node);
1013 return Project_Nodes.Table (Node).Name;
1014 end Name_Of;
1016 --------------------
1017 -- Next_Case_Item --
1018 --------------------
1020 function Next_Case_Item
1021 (Node : Project_Node_Id) return Project_Node_Id
1023 begin
1024 pragma Assert
1025 (Node /= Empty_Node
1026 and then
1027 Project_Nodes.Table (Node).Kind = N_Case_Item);
1028 return Project_Nodes.Table (Node).Field3;
1029 end Next_Case_Item;
1031 ------------------
1032 -- Next_Comment --
1033 ------------------
1035 function Next_Comment (Node : Project_Node_Id) return Project_Node_Id is
1036 begin
1037 pragma Assert
1038 (Node /= Empty_Node
1039 and then
1040 Project_Nodes.Table (Node).Kind = N_Comment);
1041 return Project_Nodes.Table (Node).Comments;
1042 end Next_Comment;
1044 ---------------------------
1045 -- Next_Declarative_Item --
1046 ---------------------------
1048 function Next_Declarative_Item
1049 (Node : Project_Node_Id) return Project_Node_Id
1051 begin
1052 pragma Assert
1053 (Node /= Empty_Node
1054 and then
1055 Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1056 return Project_Nodes.Table (Node).Field2;
1057 end Next_Declarative_Item;
1059 -----------------------------
1060 -- Next_Expression_In_List --
1061 -----------------------------
1063 function Next_Expression_In_List
1064 (Node : Project_Node_Id) return Project_Node_Id
1066 begin
1067 pragma Assert
1068 (Node /= Empty_Node
1069 and then
1070 Project_Nodes.Table (Node).Kind = N_Expression);
1071 return Project_Nodes.Table (Node).Field2;
1072 end Next_Expression_In_List;
1074 -------------------------
1075 -- Next_Literal_String --
1076 -------------------------
1078 function Next_Literal_String
1079 (Node : Project_Node_Id)
1080 return Project_Node_Id
1082 begin
1083 pragma Assert
1084 (Node /= Empty_Node
1085 and then
1086 Project_Nodes.Table (Node).Kind = N_Literal_String);
1087 return Project_Nodes.Table (Node).Field1;
1088 end Next_Literal_String;
1090 -----------------------------
1091 -- Next_Package_In_Project --
1092 -----------------------------
1094 function Next_Package_In_Project
1095 (Node : Project_Node_Id) return Project_Node_Id
1097 begin
1098 pragma Assert
1099 (Node /= Empty_Node
1100 and then
1101 Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1102 return Project_Nodes.Table (Node).Field3;
1103 end Next_Package_In_Project;
1105 ----------------------
1106 -- Next_String_Type --
1107 ----------------------
1109 function Next_String_Type
1110 (Node : Project_Node_Id)
1111 return Project_Node_Id
1113 begin
1114 pragma Assert
1115 (Node /= Empty_Node
1116 and then
1117 Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
1118 return Project_Nodes.Table (Node).Field2;
1119 end Next_String_Type;
1121 ---------------
1122 -- Next_Term --
1123 ---------------
1125 function Next_Term
1126 (Node : Project_Node_Id) return Project_Node_Id
1128 begin
1129 pragma Assert
1130 (Node /= Empty_Node
1131 and then
1132 Project_Nodes.Table (Node).Kind = N_Term);
1133 return Project_Nodes.Table (Node).Field2;
1134 end Next_Term;
1136 -------------------
1137 -- Next_Variable --
1138 -------------------
1140 function Next_Variable
1141 (Node : Project_Node_Id)
1142 return Project_Node_Id
1144 begin
1145 pragma Assert
1146 (Node /= Empty_Node
1147 and then
1148 (Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
1149 or else
1150 Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
1152 return Project_Nodes.Table (Node).Field3;
1153 end Next_Variable;
1155 -------------------------
1156 -- Next_With_Clause_Of --
1157 -------------------------
1159 function Next_With_Clause_Of
1160 (Node : Project_Node_Id) return Project_Node_Id
1162 begin
1163 pragma Assert
1164 (Node /= Empty_Node
1165 and then
1166 Project_Nodes.Table (Node).Kind = N_With_Clause);
1167 return Project_Nodes.Table (Node).Field2;
1168 end Next_With_Clause_Of;
1170 ---------------------------------
1171 -- Non_Limited_Project_Node_Of --
1172 ---------------------------------
1174 function Non_Limited_Project_Node_Of
1175 (Node : Project_Node_Id) return Project_Node_Id
1177 begin
1178 pragma Assert
1179 (Node /= Empty_Node
1180 and then
1181 (Project_Nodes.Table (Node).Kind = N_With_Clause));
1182 return Project_Nodes.Table (Node).Field3;
1183 end Non_Limited_Project_Node_Of;
1185 -------------------
1186 -- Package_Id_Of --
1187 -------------------
1189 function Package_Id_Of (Node : Project_Node_Id) return Package_Node_Id is
1190 begin
1191 pragma Assert
1192 (Node /= Empty_Node
1193 and then
1194 Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1195 return Project_Nodes.Table (Node).Pkg_Id;
1196 end Package_Id_Of;
1198 ---------------------
1199 -- Package_Node_Of --
1200 ---------------------
1202 function Package_Node_Of
1203 (Node : Project_Node_Id) return Project_Node_Id
1205 begin
1206 pragma Assert
1207 (Node /= Empty_Node
1208 and then
1209 (Project_Nodes.Table (Node).Kind = N_Variable_Reference
1210 or else
1211 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1212 return Project_Nodes.Table (Node).Field2;
1213 end Package_Node_Of;
1215 ------------------
1216 -- Path_Name_Of --
1217 ------------------
1219 function Path_Name_Of (Node : Project_Node_Id) return Name_Id is
1220 begin
1221 pragma Assert
1222 (Node /= Empty_Node
1223 and then
1224 (Project_Nodes.Table (Node).Kind = N_Project
1225 or else
1226 Project_Nodes.Table (Node).Kind = N_With_Clause));
1227 return Project_Nodes.Table (Node).Path_Name;
1228 end Path_Name_Of;
1230 ----------------------------
1231 -- Project_Declaration_Of --
1232 ----------------------------
1234 function Project_Declaration_Of
1235 (Node : Project_Node_Id) return Project_Node_Id
1237 begin
1238 pragma Assert
1239 (Node /= Empty_Node
1240 and then
1241 Project_Nodes.Table (Node).Kind = N_Project);
1242 return Project_Nodes.Table (Node).Field2;
1243 end Project_Declaration_Of;
1245 -------------------------------------------
1246 -- Project_File_Includes_Unkept_Comments --
1247 -------------------------------------------
1249 function Project_File_Includes_Unkept_Comments
1250 (Node : Project_Node_Id) return Boolean
1252 Declaration : constant Project_Node_Id := Project_Declaration_Of (Node);
1253 begin
1254 return Project_Nodes.Table (Declaration).Flag1;
1255 end Project_File_Includes_Unkept_Comments;
1257 ---------------------
1258 -- Project_Node_Of --
1259 ---------------------
1261 function Project_Node_Of
1262 (Node : Project_Node_Id) return Project_Node_Id
1264 begin
1265 pragma Assert
1266 (Node /= Empty_Node
1267 and then
1268 (Project_Nodes.Table (Node).Kind = N_With_Clause
1269 or else
1270 Project_Nodes.Table (Node).Kind = N_Variable_Reference
1271 or else
1272 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1273 return Project_Nodes.Table (Node).Field1;
1274 end Project_Node_Of;
1276 -----------------------------------
1277 -- Project_Of_Renamed_Package_Of --
1278 -----------------------------------
1280 function Project_Of_Renamed_Package_Of
1281 (Node : Project_Node_Id) return Project_Node_Id
1283 begin
1284 pragma Assert
1285 (Node /= Empty_Node
1286 and then
1287 Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1288 return Project_Nodes.Table (Node).Field1;
1289 end Project_Of_Renamed_Package_Of;
1291 --------------------------
1292 -- Remove_Next_End_Node --
1293 --------------------------
1295 procedure Remove_Next_End_Node is
1296 begin
1297 Next_End_Nodes.Decrement_Last;
1298 end Remove_Next_End_Node;
1300 -----------------
1301 -- Reset_State --
1302 -----------------
1304 procedure Reset_State is
1305 begin
1306 End_Of_Line_Node := Empty_Node;
1307 Previous_Line_Node := Empty_Node;
1308 Previous_End_Node := Empty_Node;
1309 Unkept_Comments := False;
1310 Comments.Set_Last (0);
1311 end Reset_State;
1313 -------------
1314 -- Restore --
1315 -------------
1317 procedure Restore (S : in Comment_State) is
1318 begin
1319 End_Of_Line_Node := S.End_Of_Line_Node;
1320 Previous_Line_Node := S.Previous_Line_Node;
1321 Previous_End_Node := S.Previous_End_Node;
1322 Next_End_Nodes.Set_Last (0);
1323 Unkept_Comments := S.Unkept_Comments;
1325 Comments.Set_Last (0);
1327 for J in S.Comments'Range loop
1328 Comments.Increment_Last;
1329 Comments.Table (Comments.Last) := S.Comments (J);
1330 end loop;
1331 end Restore;
1333 ----------
1334 -- Save --
1335 ----------
1337 procedure Save (S : out Comment_State) is
1338 Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last);
1340 begin
1341 for J in 1 .. Comments.Last loop
1342 Cmts (J) := Comments.Table (J);
1343 end loop;
1345 S :=
1346 (End_Of_Line_Node => End_Of_Line_Node,
1347 Previous_Line_Node => Previous_Line_Node,
1348 Previous_End_Node => Previous_End_Node,
1349 Unkept_Comments => Unkept_Comments,
1350 Comments => Cmts);
1351 end Save;
1353 ----------
1354 -- Scan --
1355 ----------
1357 procedure Scan is
1358 Empty_Line : Boolean := False;
1359 begin
1360 -- If there are comments, then they will not be kept. Set the flag and
1361 -- clear the comments.
1363 if Comments.Last > 0 then
1364 Unkept_Comments := True;
1365 Comments.Set_Last (0);
1366 end if;
1368 -- Loop until a token other that End_Of_Line or Comment is found
1370 loop
1371 Prj.Err.Scanner.Scan;
1373 case Token is
1374 when Tok_End_Of_Line =>
1375 if Prev_Token = Tok_End_Of_Line then
1376 Empty_Line := True;
1378 if Comments.Last > 0 then
1379 Comments.Table (Comments.Last).Is_Followed_By_Empty_Line
1380 := True;
1381 end if;
1382 end if;
1384 when Tok_Comment =>
1385 -- If this is a line comment, add it to the comment table
1387 if Prev_Token = Tok_End_Of_Line
1388 or else Prev_Token = No_Token
1389 then
1390 Comments.Increment_Last;
1391 Comments.Table (Comments.Last) :=
1392 (Value => Comment_Id,
1393 Follows_Empty_Line => Empty_Line,
1394 Is_Followed_By_Empty_Line => False);
1396 -- Otherwise, it is an end of line comment. If there is
1397 -- an end of line node specified, associate the comment with
1398 -- this node.
1400 elsif End_Of_Line_Node /= Empty_Node then
1401 declare
1402 Zones : constant Project_Node_Id :=
1403 Comment_Zones_Of (End_Of_Line_Node);
1404 begin
1405 Project_Nodes.Table (Zones).Value := Comment_Id;
1406 end;
1408 -- Otherwise, this end of line node cannot be kept
1410 else
1411 Unkept_Comments := True;
1412 Comments.Set_Last (0);
1413 end if;
1415 Empty_Line := False;
1417 when others =>
1418 -- If there are comments, where the first comment is not
1419 -- following an empty line, put the initial uninterrupted
1420 -- comment zone with the node of the preceding line (either
1421 -- a Previous_Line or a Previous_End node), if any.
1423 if Comments.Last > 0 and then
1424 not Comments.Table (1).Follows_Empty_Line then
1425 if Previous_Line_Node /= Empty_Node then
1426 Add_Comments
1427 (To => Previous_Line_Node, Where => After);
1429 elsif Previous_End_Node /= Empty_Node then
1430 Add_Comments
1431 (To => Previous_End_Node, Where => After_End);
1432 end if;
1433 end if;
1435 -- If there are still comments and the token is "end", then
1436 -- put these comments with the Next_End node, if any;
1437 -- otherwise, these comments cannot be kept. Always clear
1438 -- the comments.
1440 if Comments.Last > 0 and then Token = Tok_End then
1441 if Next_End_Nodes.Last > 0 then
1442 Add_Comments
1443 (To => Next_End_Nodes.Table (Next_End_Nodes.Last),
1444 Where => Before_End);
1446 else
1447 Unkept_Comments := True;
1448 end if;
1450 Comments.Set_Last (0);
1451 end if;
1453 -- Reset the End_Of_Line, Previous_Line and Previous_End nodes
1454 -- so that they are not used again.
1456 End_Of_Line_Node := Empty_Node;
1457 Previous_Line_Node := Empty_Node;
1458 Previous_End_Node := Empty_Node;
1460 -- And return
1462 exit;
1463 end case;
1464 end loop;
1465 end Scan;
1467 ------------------------------------
1468 -- Set_Associative_Array_Index_Of --
1469 ------------------------------------
1471 procedure Set_Associative_Array_Index_Of
1472 (Node : Project_Node_Id;
1473 To : Name_Id)
1475 begin
1476 pragma Assert
1477 (Node /= Empty_Node
1478 and then
1479 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1480 or else
1481 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1482 Project_Nodes.Table (Node).Value := To;
1483 end Set_Associative_Array_Index_Of;
1485 --------------------------------
1486 -- Set_Associative_Package_Of --
1487 --------------------------------
1489 procedure Set_Associative_Package_Of
1490 (Node : Project_Node_Id;
1491 To : Project_Node_Id)
1493 begin
1494 pragma Assert
1495 (Node /= Empty_Node
1496 and then
1497 Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
1498 Project_Nodes.Table (Node).Field3 := To;
1499 end Set_Associative_Package_Of;
1501 --------------------------------
1502 -- Set_Associative_Project_Of --
1503 --------------------------------
1505 procedure Set_Associative_Project_Of
1506 (Node : Project_Node_Id;
1507 To : Project_Node_Id)
1509 begin
1510 pragma Assert
1511 (Node /= Empty_Node
1512 and then
1513 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
1514 Project_Nodes.Table (Node).Field2 := To;
1515 end Set_Associative_Project_Of;
1517 --------------------------
1518 -- Set_Case_Insensitive --
1519 --------------------------
1521 procedure Set_Case_Insensitive
1522 (Node : Project_Node_Id;
1523 To : Boolean)
1525 begin
1526 pragma Assert
1527 (Node /= Empty_Node
1528 and then
1529 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1530 or else
1531 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1532 Project_Nodes.Table (Node).Flag1 := To;
1533 end Set_Case_Insensitive;
1535 ------------------------------------
1536 -- Set_Case_Variable_Reference_Of --
1537 ------------------------------------
1539 procedure Set_Case_Variable_Reference_Of
1540 (Node : Project_Node_Id;
1541 To : Project_Node_Id)
1543 begin
1544 pragma Assert
1545 (Node /= Empty_Node
1546 and then
1547 Project_Nodes.Table (Node).Kind = N_Case_Construction);
1548 Project_Nodes.Table (Node).Field1 := To;
1549 end Set_Case_Variable_Reference_Of;
1551 ---------------------------
1552 -- Set_Current_Item_Node --
1553 ---------------------------
1555 procedure Set_Current_Item_Node
1556 (Node : Project_Node_Id;
1557 To : Project_Node_Id)
1559 begin
1560 pragma Assert
1561 (Node /= Empty_Node
1562 and then
1563 Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1564 Project_Nodes.Table (Node).Field1 := To;
1565 end Set_Current_Item_Node;
1567 ----------------------
1568 -- Set_Current_Term --
1569 ----------------------
1571 procedure Set_Current_Term
1572 (Node : Project_Node_Id;
1573 To : Project_Node_Id)
1575 begin
1576 pragma Assert
1577 (Node /= Empty_Node
1578 and then
1579 Project_Nodes.Table (Node).Kind = N_Term);
1580 Project_Nodes.Table (Node).Field1 := To;
1581 end Set_Current_Term;
1583 ----------------------
1584 -- Set_Directory_Of --
1585 ----------------------
1587 procedure Set_Directory_Of
1588 (Node : Project_Node_Id;
1589 To : Name_Id)
1591 begin
1592 pragma Assert
1593 (Node /= Empty_Node
1594 and then
1595 Project_Nodes.Table (Node).Kind = N_Project);
1596 Project_Nodes.Table (Node).Directory := To;
1597 end Set_Directory_Of;
1599 ---------------------
1600 -- Set_End_Of_Line --
1601 ---------------------
1603 procedure Set_End_Of_Line (To : Project_Node_Id) is
1604 begin
1605 End_Of_Line_Node := To;
1606 end Set_End_Of_Line;
1608 ----------------------------
1609 -- Set_Expression_Kind_Of --
1610 ----------------------------
1612 procedure Set_Expression_Kind_Of
1613 (Node : Project_Node_Id;
1614 To : Variable_Kind)
1616 begin
1617 pragma Assert
1618 (Node /= Empty_Node
1619 and then
1620 (Project_Nodes.Table (Node).Kind = N_Literal_String
1621 or else
1622 Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1623 or else
1624 Project_Nodes.Table (Node).Kind = N_Variable_Declaration
1625 or else
1626 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
1627 or else
1628 Project_Nodes.Table (Node).Kind = N_Package_Declaration
1629 or else
1630 Project_Nodes.Table (Node).Kind = N_Expression
1631 or else
1632 Project_Nodes.Table (Node).Kind = N_Term
1633 or else
1634 Project_Nodes.Table (Node).Kind = N_Variable_Reference
1635 or else
1636 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1637 Project_Nodes.Table (Node).Expr_Kind := To;
1638 end Set_Expression_Kind_Of;
1640 -----------------------
1641 -- Set_Expression_Of --
1642 -----------------------
1644 procedure Set_Expression_Of
1645 (Node : Project_Node_Id;
1646 To : Project_Node_Id)
1648 begin
1649 pragma Assert
1650 (Node /= Empty_Node
1651 and then
1652 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1653 or else
1654 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
1655 or else
1656 Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
1657 Project_Nodes.Table (Node).Field1 := To;
1658 end Set_Expression_Of;
1660 -------------------------------
1661 -- Set_External_Reference_Of --
1662 -------------------------------
1664 procedure Set_External_Reference_Of
1665 (Node : Project_Node_Id;
1666 To : Project_Node_Id)
1668 begin
1669 pragma Assert
1670 (Node /= Empty_Node
1671 and then
1672 Project_Nodes.Table (Node).Kind = N_External_Value);
1673 Project_Nodes.Table (Node).Field1 := To;
1674 end Set_External_Reference_Of;
1676 -----------------------------
1677 -- Set_External_Default_Of --
1678 -----------------------------
1680 procedure Set_External_Default_Of
1681 (Node : Project_Node_Id;
1682 To : Project_Node_Id)
1684 begin
1685 pragma Assert
1686 (Node /= Empty_Node
1687 and then
1688 Project_Nodes.Table (Node).Kind = N_External_Value);
1689 Project_Nodes.Table (Node).Field2 := To;
1690 end Set_External_Default_Of;
1692 ----------------------------
1693 -- Set_First_Case_Item_Of --
1694 ----------------------------
1696 procedure Set_First_Case_Item_Of
1697 (Node : Project_Node_Id;
1698 To : Project_Node_Id)
1700 begin
1701 pragma Assert
1702 (Node /= Empty_Node
1703 and then
1704 Project_Nodes.Table (Node).Kind = N_Case_Construction);
1705 Project_Nodes.Table (Node).Field2 := To;
1706 end Set_First_Case_Item_Of;
1708 -------------------------
1709 -- Set_First_Choice_Of --
1710 -------------------------
1712 procedure Set_First_Choice_Of
1713 (Node : Project_Node_Id;
1714 To : Project_Node_Id)
1716 begin
1717 pragma Assert
1718 (Node /= Empty_Node
1719 and then
1720 Project_Nodes.Table (Node).Kind = N_Case_Item);
1721 Project_Nodes.Table (Node).Field1 := To;
1722 end Set_First_Choice_Of;
1724 -----------------------------
1725 -- Set_First_Comment_After --
1726 -----------------------------
1728 procedure Set_First_Comment_After
1729 (Node : Project_Node_Id;
1730 To : Project_Node_Id)
1732 Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
1733 begin
1734 Project_Nodes.Table (Zone).Field2 := To;
1735 end Set_First_Comment_After;
1737 ---------------------------------
1738 -- Set_First_Comment_After_End --
1739 ---------------------------------
1741 procedure Set_First_Comment_After_End
1742 (Node : Project_Node_Id;
1743 To : Project_Node_Id)
1745 Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
1746 begin
1747 Project_Nodes.Table (Zone).Comments := To;
1748 end Set_First_Comment_After_End;
1750 ------------------------------
1751 -- Set_First_Comment_Before --
1752 ------------------------------
1754 procedure Set_First_Comment_Before
1755 (Node : Project_Node_Id;
1756 To : Project_Node_Id)
1759 Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
1760 begin
1761 Project_Nodes.Table (Zone).Field1 := To;
1762 end Set_First_Comment_Before;
1764 ----------------------------------
1765 -- Set_First_Comment_Before_End --
1766 ----------------------------------
1768 procedure Set_First_Comment_Before_End
1769 (Node : Project_Node_Id;
1770 To : Project_Node_Id)
1772 Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
1773 begin
1774 Project_Nodes.Table (Zone).Field2 := To;
1775 end Set_First_Comment_Before_End;
1777 ------------------------
1778 -- Set_Next_Case_Item --
1779 ------------------------
1781 procedure Set_Next_Case_Item
1782 (Node : Project_Node_Id;
1783 To : Project_Node_Id)
1785 begin
1786 pragma Assert
1787 (Node /= Empty_Node
1788 and then
1789 Project_Nodes.Table (Node).Kind = N_Case_Item);
1790 Project_Nodes.Table (Node).Field3 := To;
1791 end Set_Next_Case_Item;
1793 ----------------------
1794 -- Set_Next_Comment --
1795 ----------------------
1797 procedure Set_Next_Comment
1798 (Node : Project_Node_Id;
1799 To : Project_Node_Id)
1801 begin
1802 pragma Assert
1803 (Node /= Empty_Node
1804 and then
1805 Project_Nodes.Table (Node).Kind = N_Comment);
1806 Project_Nodes.Table (Node).Comments := To;
1807 end Set_Next_Comment;
1809 -----------------------------------
1810 -- Set_First_Declarative_Item_Of --
1811 -----------------------------------
1813 procedure Set_First_Declarative_Item_Of
1814 (Node : Project_Node_Id;
1815 To : Project_Node_Id)
1817 begin
1818 pragma Assert
1819 (Node /= Empty_Node
1820 and then
1821 (Project_Nodes.Table (Node).Kind = N_Project_Declaration
1822 or else
1823 Project_Nodes.Table (Node).Kind = N_Case_Item
1824 or else
1825 Project_Nodes.Table (Node).Kind = N_Package_Declaration));
1827 if Project_Nodes.Table (Node).Kind = N_Project_Declaration then
1828 Project_Nodes.Table (Node).Field1 := To;
1829 else
1830 Project_Nodes.Table (Node).Field2 := To;
1831 end if;
1832 end Set_First_Declarative_Item_Of;
1834 ----------------------------------
1835 -- Set_First_Expression_In_List --
1836 ----------------------------------
1838 procedure Set_First_Expression_In_List
1839 (Node : Project_Node_Id;
1840 To : Project_Node_Id)
1842 begin
1843 pragma Assert
1844 (Node /= Empty_Node
1845 and then
1846 Project_Nodes.Table (Node).Kind = N_Literal_String_List);
1847 Project_Nodes.Table (Node).Field1 := To;
1848 end Set_First_Expression_In_List;
1850 ------------------------------
1851 -- Set_First_Literal_String --
1852 ------------------------------
1854 procedure Set_First_Literal_String
1855 (Node : Project_Node_Id;
1856 To : Project_Node_Id)
1858 begin
1859 pragma Assert
1860 (Node /= Empty_Node
1861 and then
1862 Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
1863 Project_Nodes.Table (Node).Field1 := To;
1864 end Set_First_Literal_String;
1866 --------------------------
1867 -- Set_First_Package_Of --
1868 --------------------------
1870 procedure Set_First_Package_Of
1871 (Node : Project_Node_Id;
1872 To : Package_Declaration_Id)
1874 begin
1875 pragma Assert
1876 (Node /= Empty_Node
1877 and then
1878 Project_Nodes.Table (Node).Kind = N_Project);
1879 Project_Nodes.Table (Node).Packages := To;
1880 end Set_First_Package_Of;
1882 ------------------------------
1883 -- Set_First_String_Type_Of --
1884 ------------------------------
1886 procedure Set_First_String_Type_Of
1887 (Node : Project_Node_Id;
1888 To : Project_Node_Id)
1890 begin
1891 pragma Assert
1892 (Node /= Empty_Node
1893 and then
1894 Project_Nodes.Table (Node).Kind = N_Project);
1895 Project_Nodes.Table (Node).Field3 := To;
1896 end Set_First_String_Type_Of;
1898 --------------------
1899 -- Set_First_Term --
1900 --------------------
1902 procedure Set_First_Term
1903 (Node : Project_Node_Id;
1904 To : Project_Node_Id)
1906 begin
1907 pragma Assert
1908 (Node /= Empty_Node
1909 and then
1910 Project_Nodes.Table (Node).Kind = N_Expression);
1911 Project_Nodes.Table (Node).Field1 := To;
1912 end Set_First_Term;
1914 ---------------------------
1915 -- Set_First_Variable_Of --
1916 ---------------------------
1918 procedure Set_First_Variable_Of
1919 (Node : Project_Node_Id;
1920 To : Variable_Node_Id)
1922 begin
1923 pragma Assert
1924 (Node /= Empty_Node
1925 and then
1926 (Project_Nodes.Table (Node).Kind = N_Project
1927 or else
1928 Project_Nodes.Table (Node).Kind = N_Package_Declaration));
1929 Project_Nodes.Table (Node).Variables := To;
1930 end Set_First_Variable_Of;
1932 ------------------------------
1933 -- Set_First_With_Clause_Of --
1934 ------------------------------
1936 procedure Set_First_With_Clause_Of
1937 (Node : Project_Node_Id;
1938 To : Project_Node_Id)
1940 begin
1941 pragma Assert
1942 (Node /= Empty_Node
1943 and then
1944 Project_Nodes.Table (Node).Kind = N_Project);
1945 Project_Nodes.Table (Node).Field1 := To;
1946 end Set_First_With_Clause_Of;
1948 --------------------------
1949 -- Set_Is_Extending_All --
1950 --------------------------
1952 procedure Set_Is_Extending_All (Node : Project_Node_Id) is
1953 begin
1954 pragma Assert
1955 (Node /= Empty_Node
1956 and then
1957 (Project_Nodes.Table (Node).Kind = N_Project
1958 or else
1959 Project_Nodes.Table (Node).Kind = N_With_Clause));
1960 Project_Nodes.Table (Node).Flag2 := True;
1961 end Set_Is_Extending_All;
1963 -----------------
1964 -- Set_Kind_Of --
1965 -----------------
1967 procedure Set_Kind_Of
1968 (Node : Project_Node_Id;
1969 To : Project_Node_Kind)
1971 begin
1972 pragma Assert (Node /= Empty_Node);
1973 Project_Nodes.Table (Node).Kind := To;
1974 end Set_Kind_Of;
1976 ---------------------
1977 -- Set_Location_Of --
1978 ---------------------
1980 procedure Set_Location_Of
1981 (Node : Project_Node_Id;
1982 To : Source_Ptr)
1984 begin
1985 pragma Assert (Node /= Empty_Node);
1986 Project_Nodes.Table (Node).Location := To;
1987 end Set_Location_Of;
1989 -----------------------------
1990 -- Set_Extended_Project_Of --
1991 -----------------------------
1993 procedure Set_Extended_Project_Of
1994 (Node : Project_Node_Id;
1995 To : Project_Node_Id)
1997 begin
1998 pragma Assert
1999 (Node /= Empty_Node
2000 and then
2001 Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2002 Project_Nodes.Table (Node).Field2 := To;
2003 end Set_Extended_Project_Of;
2005 ----------------------------------
2006 -- Set_Extended_Project_Path_Of --
2007 ----------------------------------
2009 procedure Set_Extended_Project_Path_Of
2010 (Node : Project_Node_Id;
2011 To : Name_Id)
2013 begin
2014 pragma Assert
2015 (Node /= Empty_Node
2016 and then
2017 Project_Nodes.Table (Node).Kind = N_Project);
2018 Project_Nodes.Table (Node).Value := To;
2019 end Set_Extended_Project_Path_Of;
2021 ------------------------------
2022 -- Set_Extending_Project_Of --
2023 ------------------------------
2025 procedure Set_Extending_Project_Of
2026 (Node : Project_Node_Id;
2027 To : Project_Node_Id)
2029 begin
2030 pragma Assert
2031 (Node /= Empty_Node
2032 and then
2033 Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2034 Project_Nodes.Table (Node).Field3 := To;
2035 end Set_Extending_Project_Of;
2037 -----------------
2038 -- Set_Name_Of --
2039 -----------------
2041 procedure Set_Name_Of
2042 (Node : Project_Node_Id;
2043 To : Name_Id)
2045 begin
2046 pragma Assert (Node /= Empty_Node);
2047 Project_Nodes.Table (Node).Name := To;
2048 end Set_Name_Of;
2050 -------------------------------
2051 -- Set_Next_Declarative_Item --
2052 -------------------------------
2054 procedure Set_Next_Declarative_Item
2055 (Node : Project_Node_Id;
2056 To : Project_Node_Id)
2058 begin
2059 pragma Assert
2060 (Node /= Empty_Node
2061 and then
2062 Project_Nodes.Table (Node).Kind = N_Declarative_Item);
2063 Project_Nodes.Table (Node).Field2 := To;
2064 end Set_Next_Declarative_Item;
2066 -----------------------
2067 -- Set_Next_End_Node --
2068 -----------------------
2070 procedure Set_Next_End_Node (To : Project_Node_Id) is
2071 begin
2072 Next_End_Nodes.Increment_Last;
2073 Next_End_Nodes.Table (Next_End_Nodes.Last) := To;
2074 end Set_Next_End_Node;
2076 ---------------------------------
2077 -- Set_Next_Expression_In_List --
2078 ---------------------------------
2080 procedure Set_Next_Expression_In_List
2081 (Node : Project_Node_Id;
2082 To : Project_Node_Id)
2084 begin
2085 pragma Assert
2086 (Node /= Empty_Node
2087 and then
2088 Project_Nodes.Table (Node).Kind = N_Expression);
2089 Project_Nodes.Table (Node).Field2 := To;
2090 end Set_Next_Expression_In_List;
2092 -----------------------------
2093 -- Set_Next_Literal_String --
2094 -----------------------------
2096 procedure Set_Next_Literal_String
2097 (Node : Project_Node_Id;
2098 To : Project_Node_Id)
2100 begin
2101 pragma Assert
2102 (Node /= Empty_Node
2103 and then
2104 Project_Nodes.Table (Node).Kind = N_Literal_String);
2105 Project_Nodes.Table (Node).Field1 := To;
2106 end Set_Next_Literal_String;
2108 ---------------------------------
2109 -- Set_Next_Package_In_Project --
2110 ---------------------------------
2112 procedure Set_Next_Package_In_Project
2113 (Node : Project_Node_Id;
2114 To : Project_Node_Id)
2116 begin
2117 pragma Assert
2118 (Node /= Empty_Node
2119 and then
2120 Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2121 Project_Nodes.Table (Node).Field3 := To;
2122 end Set_Next_Package_In_Project;
2124 --------------------------
2125 -- Set_Next_String_Type --
2126 --------------------------
2128 procedure Set_Next_String_Type
2129 (Node : Project_Node_Id;
2130 To : Project_Node_Id)
2132 begin
2133 pragma Assert
2134 (Node /= Empty_Node
2135 and then
2136 Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
2137 Project_Nodes.Table (Node).Field2 := To;
2138 end Set_Next_String_Type;
2140 -------------------
2141 -- Set_Next_Term --
2142 -------------------
2144 procedure Set_Next_Term
2145 (Node : Project_Node_Id;
2146 To : Project_Node_Id)
2148 begin
2149 pragma Assert
2150 (Node /= Empty_Node
2151 and then
2152 Project_Nodes.Table (Node).Kind = N_Term);
2153 Project_Nodes.Table (Node).Field2 := To;
2154 end Set_Next_Term;
2156 -----------------------
2157 -- Set_Next_Variable --
2158 -----------------------
2160 procedure Set_Next_Variable
2161 (Node : Project_Node_Id;
2162 To : Project_Node_Id)
2164 begin
2165 pragma Assert
2166 (Node /= Empty_Node
2167 and then
2168 (Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
2169 or else
2170 Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
2171 Project_Nodes.Table (Node).Field3 := To;
2172 end Set_Next_Variable;
2174 -----------------------------
2175 -- Set_Next_With_Clause_Of --
2176 -----------------------------
2178 procedure Set_Next_With_Clause_Of
2179 (Node : Project_Node_Id;
2180 To : Project_Node_Id)
2182 begin
2183 pragma Assert
2184 (Node /= Empty_Node
2185 and then
2186 Project_Nodes.Table (Node).Kind = N_With_Clause);
2187 Project_Nodes.Table (Node).Field2 := To;
2188 end Set_Next_With_Clause_Of;
2190 -----------------------
2191 -- Set_Package_Id_Of --
2192 -----------------------
2194 procedure Set_Package_Id_Of
2195 (Node : Project_Node_Id;
2196 To : Package_Node_Id)
2198 begin
2199 pragma Assert
2200 (Node /= Empty_Node
2201 and then
2202 Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2203 Project_Nodes.Table (Node).Pkg_Id := To;
2204 end Set_Package_Id_Of;
2206 -------------------------
2207 -- Set_Package_Node_Of --
2208 -------------------------
2210 procedure Set_Package_Node_Of
2211 (Node : Project_Node_Id;
2212 To : Project_Node_Id)
2214 begin
2215 pragma Assert
2216 (Node /= Empty_Node
2217 and then
2218 (Project_Nodes.Table (Node).Kind = N_Variable_Reference
2219 or else
2220 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2221 Project_Nodes.Table (Node).Field2 := To;
2222 end Set_Package_Node_Of;
2224 ----------------------
2225 -- Set_Path_Name_Of --
2226 ----------------------
2228 procedure Set_Path_Name_Of
2229 (Node : Project_Node_Id;
2230 To : Name_Id)
2232 begin
2233 pragma Assert
2234 (Node /= Empty_Node
2235 and then
2236 (Project_Nodes.Table (Node).Kind = N_Project
2237 or else
2238 Project_Nodes.Table (Node).Kind = N_With_Clause));
2239 Project_Nodes.Table (Node).Path_Name := To;
2240 end Set_Path_Name_Of;
2242 ---------------------------
2243 -- Set_Previous_End_Node --
2244 ---------------------------
2245 procedure Set_Previous_End_Node (To : Project_Node_Id) is
2246 begin
2247 Previous_End_Node := To;
2248 end Set_Previous_End_Node;
2250 ----------------------------
2251 -- Set_Previous_Line_Node --
2252 ----------------------------
2254 procedure Set_Previous_Line_Node (To : Project_Node_Id) is
2255 begin
2256 Previous_Line_Node := To;
2257 end Set_Previous_Line_Node;
2259 --------------------------------
2260 -- Set_Project_Declaration_Of --
2261 --------------------------------
2263 procedure Set_Project_Declaration_Of
2264 (Node : Project_Node_Id;
2265 To : Project_Node_Id)
2267 begin
2268 pragma Assert
2269 (Node /= Empty_Node
2270 and then
2271 Project_Nodes.Table (Node).Kind = N_Project);
2272 Project_Nodes.Table (Node).Field2 := To;
2273 end Set_Project_Declaration_Of;
2275 -----------------------------------------------
2276 -- Set_Project_File_Includes_Unkept_Comments --
2277 -----------------------------------------------
2279 procedure Set_Project_File_Includes_Unkept_Comments
2280 (Node : Project_Node_Id;
2281 To : Boolean)
2283 Declaration : constant Project_Node_Id := Project_Declaration_Of (Node);
2284 begin
2285 Project_Nodes.Table (Declaration).Flag1 := To;
2286 end Set_Project_File_Includes_Unkept_Comments;
2288 -------------------------
2289 -- Set_Project_Node_Of --
2290 -------------------------
2292 procedure Set_Project_Node_Of
2293 (Node : Project_Node_Id;
2294 To : Project_Node_Id;
2295 Limited_With : Boolean := False)
2297 begin
2298 pragma Assert
2299 (Node /= Empty_Node
2300 and then
2301 (Project_Nodes.Table (Node).Kind = N_With_Clause
2302 or else
2303 Project_Nodes.Table (Node).Kind = N_Variable_Reference
2304 or else
2305 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2306 Project_Nodes.Table (Node).Field1 := To;
2308 if Project_Nodes.Table (Node).Kind = N_With_Clause
2309 and then not Limited_With
2310 then
2311 Project_Nodes.Table (Node).Field3 := To;
2312 end if;
2313 end Set_Project_Node_Of;
2315 ---------------------------------------
2316 -- Set_Project_Of_Renamed_Package_Of --
2317 ---------------------------------------
2319 procedure Set_Project_Of_Renamed_Package_Of
2320 (Node : Project_Node_Id;
2321 To : Project_Node_Id)
2323 begin
2324 pragma Assert
2325 (Node /= Empty_Node
2326 and then
2327 Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2328 Project_Nodes.Table (Node).Field1 := To;
2329 end Set_Project_Of_Renamed_Package_Of;
2331 -------------------------
2332 -- Set_Source_Index_Of --
2333 -------------------------
2335 procedure Set_Source_Index_Of
2336 (Node : Project_Node_Id;
2337 To : Int)
2339 begin
2340 pragma Assert
2341 (Node /= Empty_Node
2342 and then
2343 (Project_Nodes.Table (Node).Kind = N_Literal_String
2344 or else
2345 Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
2346 Project_Nodes.Table (Node).Src_Index := To;
2347 end Set_Source_Index_Of;
2349 ------------------------
2350 -- Set_String_Type_Of --
2351 ------------------------
2353 procedure Set_String_Type_Of
2354 (Node : Project_Node_Id;
2355 To : Project_Node_Id)
2357 begin
2358 pragma Assert
2359 (Node /= Empty_Node
2360 and then
2361 (Project_Nodes.Table (Node).Kind = N_Variable_Reference
2362 or else
2363 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration)
2364 and then
2365 Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
2367 if Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2368 Project_Nodes.Table (Node).Field3 := To;
2369 else
2370 Project_Nodes.Table (Node).Field2 := To;
2371 end if;
2372 end Set_String_Type_Of;
2374 -------------------------
2375 -- Set_String_Value_Of --
2376 -------------------------
2378 procedure Set_String_Value_Of
2379 (Node : Project_Node_Id;
2380 To : Name_Id)
2382 begin
2383 pragma Assert
2384 (Node /= Empty_Node
2385 and then
2386 (Project_Nodes.Table (Node).Kind = N_With_Clause
2387 or else
2388 Project_Nodes.Table (Node).Kind = N_Comment
2389 or else
2390 Project_Nodes.Table (Node).Kind = N_Literal_String));
2391 Project_Nodes.Table (Node).Value := To;
2392 end Set_String_Value_Of;
2394 ---------------------
2395 -- Source_Index_Of --
2396 ---------------------
2398 function Source_Index_Of (Node : Project_Node_Id) return Int is
2399 begin
2400 pragma Assert
2401 (Node /= Empty_Node
2402 and then
2403 (Project_Nodes.Table (Node).Kind = N_Literal_String
2404 or else
2405 Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
2406 return Project_Nodes.Table (Node).Src_Index;
2407 end Source_Index_Of;
2409 --------------------
2410 -- String_Type_Of --
2411 --------------------
2413 function String_Type_Of (Node : Project_Node_Id) return Project_Node_Id is
2414 begin
2415 pragma Assert
2416 (Node /= Empty_Node
2417 and then
2418 (Project_Nodes.Table (Node).Kind = N_Variable_Reference
2419 or else
2420 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration));
2422 if Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2423 return Project_Nodes.Table (Node).Field3;
2424 else
2425 return Project_Nodes.Table (Node).Field2;
2426 end if;
2427 end String_Type_Of;
2429 ---------------------
2430 -- String_Value_Of --
2431 ---------------------
2433 function String_Value_Of (Node : Project_Node_Id) return Name_Id is
2434 begin
2435 pragma Assert
2436 (Node /= Empty_Node
2437 and then
2438 (Project_Nodes.Table (Node).Kind = N_With_Clause
2439 or else
2440 Project_Nodes.Table (Node).Kind = N_Comment
2441 or else
2442 Project_Nodes.Table (Node).Kind = N_Literal_String));
2443 return Project_Nodes.Table (Node).Value;
2444 end String_Value_Of;
2446 --------------------
2447 -- Value_Is_Valid --
2448 --------------------
2450 function Value_Is_Valid
2451 (For_Typed_Variable : Project_Node_Id;
2452 Value : Name_Id) return Boolean
2454 begin
2455 pragma Assert
2456 (For_Typed_Variable /= Empty_Node
2457 and then
2458 (Project_Nodes.Table (For_Typed_Variable).Kind =
2459 N_Typed_Variable_Declaration));
2461 declare
2462 Current_String : Project_Node_Id :=
2463 First_Literal_String
2464 (String_Type_Of (For_Typed_Variable));
2466 begin
2467 while Current_String /= Empty_Node
2468 and then
2469 String_Value_Of (Current_String) /= Value
2470 loop
2471 Current_String :=
2472 Next_Literal_String (Current_String);
2473 end loop;
2475 return Current_String /= Empty_Node;
2476 end;
2478 end Value_Is_Valid;
2480 -------------------------------
2481 -- There_Are_Unkept_Comments --
2482 -------------------------------
2484 function There_Are_Unkept_Comments return Boolean is
2485 begin
2486 return Unkept_Comments;
2487 end There_Are_Unkept_Comments;
2489 end Prj.Tree;