Merge -r 127928:132243 from trunk
[official-gcc.git] / gcc / ada / prj-tree.adb
blobee2060585578f92f35fb8795d562950c512cf9a9
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-2007, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 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 ------------------------------------------------------------------------------
26 with Prj.Err;
28 package body Prj.Tree is
30 Node_With_Comments : constant array (Project_Node_Kind) of Boolean :=
31 (N_Project => True,
32 N_With_Clause => True,
33 N_Project_Declaration => False,
34 N_Declarative_Item => False,
35 N_Package_Declaration => True,
36 N_String_Type_Declaration => True,
37 N_Literal_String => False,
38 N_Attribute_Declaration => True,
39 N_Typed_Variable_Declaration => True,
40 N_Variable_Declaration => True,
41 N_Expression => False,
42 N_Term => False,
43 N_Literal_String_List => False,
44 N_Variable_Reference => False,
45 N_External_Value => False,
46 N_Attribute_Reference => False,
47 N_Case_Construction => True,
48 N_Case_Item => True,
49 N_Comment_Zones => True,
50 N_Comment => True);
51 -- Indicates the kinds of node that may have associated comments
53 package Next_End_Nodes is new Table.Table
54 (Table_Component_Type => Project_Node_Id,
55 Table_Index_Type => Natural,
56 Table_Low_Bound => 1,
57 Table_Initial => 10,
58 Table_Increment => 100,
59 Table_Name => "Next_End_Nodes");
60 -- A stack of nodes to indicates to what node the next "end" is associated
62 use Tree_Private_Part;
64 End_Of_Line_Node : Project_Node_Id := Empty_Node;
65 -- The node an end of line comment may be associated with
67 Previous_Line_Node : Project_Node_Id := Empty_Node;
68 -- The node an immediately following comment may be associated with
70 Previous_End_Node : Project_Node_Id := Empty_Node;
71 -- The node comments immediately following an "end" line may be
72 -- associated with.
74 Unkept_Comments : Boolean := False;
75 -- Set to True when some comments may not be associated with any node
77 function Comment_Zones_Of
78 (Node : Project_Node_Id;
79 In_Tree : Project_Node_Tree_Ref) 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
89 (To : Project_Node_Id;
90 In_Tree : Project_Node_Tree_Ref;
91 Where : Comment_Location) is
92 Zone : Project_Node_Id := Empty_Node;
93 Previous : Project_Node_Id := Empty_Node;
95 begin
96 pragma Assert
97 (To /= Empty_Node
98 and then
99 In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
101 Zone := In_Tree.Project_Nodes.Table (To).Comments;
103 if Zone = Empty_Node then
105 -- Create new N_Comment_Zones node
107 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
108 In_Tree.Project_Nodes.Table
109 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
110 (Kind => N_Comment_Zones,
111 Expr_Kind => Undefined,
112 Location => No_Location,
113 Directory => No_Path,
114 Variables => Empty_Node,
115 Packages => Empty_Node,
116 Pkg_Id => Empty_Package,
117 Name => No_Name,
118 Src_Index => 0,
119 Path_Name => No_Path,
120 Value => No_Name,
121 Field1 => Empty_Node,
122 Field2 => Empty_Node,
123 Field3 => Empty_Node,
124 Flag1 => False,
125 Flag2 => False,
126 Comments => Empty_Node);
128 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
129 In_Tree.Project_Nodes.Table (To).Comments := Zone;
130 end if;
132 if Where = End_Of_Line then
133 In_Tree.Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
135 else
136 -- Get each comments in the Comments table and link them to node To
138 for J in 1 .. Comments.Last loop
140 -- Create new N_Comment node
142 if (Where = After or else Where = After_End) and then
143 Token /= Tok_EOF and then
144 Comments.Table (J).Follows_Empty_Line
145 then
146 Comments.Table (1 .. Comments.Last - J + 1) :=
147 Comments.Table (J .. Comments.Last);
148 Comments.Set_Last (Comments.Last - J + 1);
149 return;
150 end if;
152 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
153 In_Tree.Project_Nodes.Table
154 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
155 (Kind => N_Comment,
156 Expr_Kind => Undefined,
157 Flag1 => Comments.Table (J).Follows_Empty_Line,
158 Flag2 =>
159 Comments.Table (J).Is_Followed_By_Empty_Line,
160 Location => No_Location,
161 Directory => No_Path,
162 Variables => Empty_Node,
163 Packages => Empty_Node,
164 Pkg_Id => Empty_Package,
165 Name => No_Name,
166 Src_Index => 0,
167 Path_Name => No_Path,
168 Value => Comments.Table (J).Value,
169 Field1 => Empty_Node,
170 Field2 => Empty_Node,
171 Field3 => Empty_Node,
172 Comments => Empty_Node);
174 -- If this is the first comment, put it in the right field of
175 -- the node Zone.
177 if Previous = Empty_Node then
178 case Where is
179 when Before =>
180 In_Tree.Project_Nodes.Table (Zone).Field1 :=
181 Project_Node_Table.Last (In_Tree.Project_Nodes);
183 when After =>
184 In_Tree.Project_Nodes.Table (Zone).Field2 :=
185 Project_Node_Table.Last (In_Tree.Project_Nodes);
187 when Before_End =>
188 In_Tree.Project_Nodes.Table (Zone).Field3 :=
189 Project_Node_Table.Last (In_Tree.Project_Nodes);
191 when After_End =>
192 In_Tree.Project_Nodes.Table (Zone).Comments :=
193 Project_Node_Table.Last (In_Tree.Project_Nodes);
195 when End_Of_Line =>
196 null;
197 end case;
199 else
200 -- When it is not the first, link it to the previous one
202 In_Tree.Project_Nodes.Table (Previous).Comments :=
203 Project_Node_Table.Last (In_Tree.Project_Nodes);
204 end if;
206 -- This node becomes the previous one for the next comment, if
207 -- there is one.
209 Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
210 end loop;
211 end if;
213 -- Empty the Comments table, so that there is no risk to link the same
214 -- comments to another node.
216 Comments.Set_Last (0);
217 end Add_Comments;
219 --------------------------------
220 -- Associative_Array_Index_Of --
221 --------------------------------
223 function Associative_Array_Index_Of
224 (Node : Project_Node_Id;
225 In_Tree : Project_Node_Tree_Ref) return Name_Id
227 begin
228 pragma Assert
229 (Node /= Empty_Node
230 and then
231 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
232 or else
233 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
234 return In_Tree.Project_Nodes.Table (Node).Value;
235 end Associative_Array_Index_Of;
237 ----------------------------
238 -- Associative_Package_Of --
239 ----------------------------
241 function Associative_Package_Of
242 (Node : Project_Node_Id;
243 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
245 begin
246 pragma Assert
247 (Node /= Empty_Node
248 and then
249 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
250 return In_Tree.Project_Nodes.Table (Node).Field3;
251 end Associative_Package_Of;
253 ----------------------------
254 -- Associative_Project_Of --
255 ----------------------------
257 function Associative_Project_Of
258 (Node : Project_Node_Id;
259 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
261 begin
262 pragma Assert
263 (Node /= Empty_Node
264 and then
265 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
266 return In_Tree.Project_Nodes.Table (Node).Field2;
267 end Associative_Project_Of;
269 ----------------------
270 -- Case_Insensitive --
271 ----------------------
273 function Case_Insensitive
274 (Node : Project_Node_Id;
275 In_Tree : Project_Node_Tree_Ref) return Boolean is
276 begin
277 pragma Assert
278 (Node /= Empty_Node
279 and then
280 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
281 or else
282 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
283 return In_Tree.Project_Nodes.Table (Node).Flag1;
284 end Case_Insensitive;
286 --------------------------------
287 -- Case_Variable_Reference_Of --
288 --------------------------------
290 function Case_Variable_Reference_Of
291 (Node : Project_Node_Id;
292 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
294 begin
295 pragma Assert
296 (Node /= Empty_Node
297 and then
298 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
299 return In_Tree.Project_Nodes.Table (Node).Field1;
300 end Case_Variable_Reference_Of;
302 ----------------------
303 -- Comment_Zones_Of --
304 ----------------------
306 function Comment_Zones_Of
307 (Node : Project_Node_Id;
308 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
310 Zone : Project_Node_Id;
312 begin
313 pragma Assert (Node /= Empty_Node);
314 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
316 -- If there is not already an N_Comment_Zones associated, create a new
317 -- one and associate it with node Node.
319 if Zone = Empty_Node then
320 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
321 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
322 In_Tree.Project_Nodes.Table (Zone) :=
323 (Kind => N_Comment_Zones,
324 Location => No_Location,
325 Directory => No_Path,
326 Expr_Kind => Undefined,
327 Variables => Empty_Node,
328 Packages => Empty_Node,
329 Pkg_Id => Empty_Package,
330 Name => No_Name,
331 Src_Index => 0,
332 Path_Name => No_Path,
333 Value => No_Name,
334 Field1 => Empty_Node,
335 Field2 => Empty_Node,
336 Field3 => Empty_Node,
337 Flag1 => False,
338 Flag2 => False,
339 Comments => Empty_Node);
340 In_Tree.Project_Nodes.Table (Node).Comments := Zone;
341 end if;
343 return Zone;
344 end Comment_Zones_Of;
346 -----------------------
347 -- Current_Item_Node --
348 -----------------------
350 function Current_Item_Node
351 (Node : Project_Node_Id;
352 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
354 begin
355 pragma Assert
356 (Node /= Empty_Node
357 and then
358 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
359 return In_Tree.Project_Nodes.Table (Node).Field1;
360 end Current_Item_Node;
362 ------------------
363 -- Current_Term --
364 ------------------
366 function Current_Term
367 (Node : Project_Node_Id;
368 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
370 begin
371 pragma Assert
372 (Node /= Empty_Node
373 and then
374 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
375 return In_Tree.Project_Nodes.Table (Node).Field1;
376 end Current_Term;
378 --------------------------
379 -- Default_Project_Node --
380 --------------------------
382 function Default_Project_Node
383 (In_Tree : Project_Node_Tree_Ref;
384 Of_Kind : Project_Node_Kind;
385 And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id
387 Result : Project_Node_Id;
388 Zone : Project_Node_Id;
389 Previous : Project_Node_Id;
391 begin
392 -- Create new node with specified kind and expression kind
394 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
395 In_Tree.Project_Nodes.Table
396 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
397 (Kind => Of_Kind,
398 Location => No_Location,
399 Directory => No_Path,
400 Expr_Kind => And_Expr_Kind,
401 Variables => Empty_Node,
402 Packages => Empty_Node,
403 Pkg_Id => Empty_Package,
404 Name => No_Name,
405 Src_Index => 0,
406 Path_Name => No_Path,
407 Value => No_Name,
408 Field1 => Empty_Node,
409 Field2 => Empty_Node,
410 Field3 => Empty_Node,
411 Flag1 => False,
412 Flag2 => False,
413 Comments => Empty_Node);
415 -- Save the new node for the returned value
417 Result := Project_Node_Table.Last (In_Tree.Project_Nodes);
419 if Comments.Last > 0 then
421 -- If this is not a node with comments, then set the flag
423 if not Node_With_Comments (Of_Kind) then
424 Unkept_Comments := True;
426 elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then
428 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
429 In_Tree.Project_Nodes.Table
430 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
431 (Kind => N_Comment_Zones,
432 Expr_Kind => Undefined,
433 Location => No_Location,
434 Directory => No_Path,
435 Variables => Empty_Node,
436 Packages => Empty_Node,
437 Pkg_Id => Empty_Package,
438 Name => No_Name,
439 Src_Index => 0,
440 Path_Name => No_Path,
441 Value => No_Name,
442 Field1 => Empty_Node,
443 Field2 => Empty_Node,
444 Field3 => Empty_Node,
445 Flag1 => False,
446 Flag2 => False,
447 Comments => Empty_Node);
449 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
450 In_Tree.Project_Nodes.Table (Result).Comments := Zone;
451 Previous := Empty_Node;
453 for J in 1 .. Comments.Last loop
455 -- Create a new N_Comment node
457 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
458 In_Tree.Project_Nodes.Table
459 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
460 (Kind => N_Comment,
461 Expr_Kind => Undefined,
462 Flag1 => Comments.Table (J).Follows_Empty_Line,
463 Flag2 =>
464 Comments.Table (J).Is_Followed_By_Empty_Line,
465 Location => No_Location,
466 Directory => No_Path,
467 Variables => Empty_Node,
468 Packages => Empty_Node,
469 Pkg_Id => Empty_Package,
470 Name => No_Name,
471 Src_Index => 0,
472 Path_Name => No_Path,
473 Value => Comments.Table (J).Value,
474 Field1 => Empty_Node,
475 Field2 => Empty_Node,
476 Field3 => Empty_Node,
477 Comments => Empty_Node);
479 -- Link it to the N_Comment_Zones node, if it is the first,
480 -- otherwise to the previous one.
482 if Previous = Empty_Node then
483 In_Tree.Project_Nodes.Table (Zone).Field1 :=
484 Project_Node_Table.Last (In_Tree.Project_Nodes);
486 else
487 In_Tree.Project_Nodes.Table (Previous).Comments :=
488 Project_Node_Table.Last (In_Tree.Project_Nodes);
489 end if;
491 -- This new node will be the previous one for the next
492 -- N_Comment node, if there is one.
494 Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
495 end loop;
497 -- Empty the Comments table after all comments have been processed
499 Comments.Set_Last (0);
500 end if;
501 end if;
503 return Result;
504 end Default_Project_Node;
506 ------------------
507 -- Directory_Of --
508 ------------------
510 function Directory_Of
511 (Node : Project_Node_Id;
512 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is
513 begin
514 pragma Assert
515 (Node /= Empty_Node
516 and then
517 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
518 return In_Tree.Project_Nodes.Table (Node).Directory;
519 end Directory_Of;
521 -------------------------
522 -- End_Of_Line_Comment --
523 -------------------------
525 function End_Of_Line_Comment
526 (Node : Project_Node_Id;
527 In_Tree : Project_Node_Tree_Ref) return Name_Id is
528 Zone : Project_Node_Id := Empty_Node;
530 begin
531 pragma Assert (Node /= Empty_Node);
532 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
534 if Zone = Empty_Node then
535 return No_Name;
536 else
537 return In_Tree.Project_Nodes.Table (Zone).Value;
538 end if;
539 end End_Of_Line_Comment;
541 ------------------------
542 -- Expression_Kind_Of --
543 ------------------------
545 function Expression_Kind_Of
546 (Node : Project_Node_Id;
547 In_Tree : Project_Node_Tree_Ref) return Variable_Kind is
548 begin
549 pragma Assert
550 (Node /= Empty_Node
551 and then
552 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
553 or else
554 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
555 or else
556 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
557 or else
558 In_Tree.Project_Nodes.Table (Node).Kind =
559 N_Typed_Variable_Declaration
560 or else
561 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
562 or else
563 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
564 or else
565 In_Tree.Project_Nodes.Table (Node).Kind = N_Term
566 or else
567 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
568 or else
569 In_Tree.Project_Nodes.Table (Node).Kind =
570 N_Attribute_Reference));
572 return In_Tree.Project_Nodes.Table (Node).Expr_Kind;
573 end Expression_Kind_Of;
575 -------------------
576 -- Expression_Of --
577 -------------------
579 function Expression_Of
580 (Node : Project_Node_Id;
581 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
583 begin
584 pragma Assert
585 (Node /= Empty_Node
586 and then
587 (In_Tree.Project_Nodes.Table (Node).Kind =
588 N_Attribute_Declaration
589 or else
590 In_Tree.Project_Nodes.Table (Node).Kind =
591 N_Typed_Variable_Declaration
592 or else
593 In_Tree.Project_Nodes.Table (Node).Kind =
594 N_Variable_Declaration));
596 return In_Tree.Project_Nodes.Table (Node).Field1;
597 end Expression_Of;
599 -------------------------
600 -- Extended_Project_Of --
601 -------------------------
603 function Extended_Project_Of
604 (Node : Project_Node_Id;
605 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
607 begin
608 pragma Assert
609 (Node /= Empty_Node
610 and then
611 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
612 return In_Tree.Project_Nodes.Table (Node).Field2;
613 end Extended_Project_Of;
615 ------------------------------
616 -- Extended_Project_Path_Of --
617 ------------------------------
619 function Extended_Project_Path_Of
620 (Node : Project_Node_Id;
621 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
623 begin
624 pragma Assert
625 (Node /= Empty_Node
626 and then
627 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
628 return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value);
629 end Extended_Project_Path_Of;
631 --------------------------
632 -- Extending_Project_Of --
633 --------------------------
634 function Extending_Project_Of
635 (Node : Project_Node_Id;
636 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
638 begin
639 pragma Assert
640 (Node /= Empty_Node
641 and then
642 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
643 return In_Tree.Project_Nodes.Table (Node).Field3;
644 end Extending_Project_Of;
646 ---------------------------
647 -- External_Reference_Of --
648 ---------------------------
650 function External_Reference_Of
651 (Node : Project_Node_Id;
652 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
654 begin
655 pragma Assert
656 (Node /= Empty_Node
657 and then
658 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
659 return In_Tree.Project_Nodes.Table (Node).Field1;
660 end External_Reference_Of;
662 -------------------------
663 -- External_Default_Of --
664 -------------------------
666 function External_Default_Of
667 (Node : Project_Node_Id;
668 In_Tree : Project_Node_Tree_Ref)
669 return Project_Node_Id
671 begin
672 pragma Assert
673 (Node /= Empty_Node
674 and then
675 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
676 return In_Tree.Project_Nodes.Table (Node).Field2;
677 end External_Default_Of;
679 ------------------------
680 -- First_Case_Item_Of --
681 ------------------------
683 function First_Case_Item_Of
684 (Node : Project_Node_Id;
685 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
687 begin
688 pragma Assert
689 (Node /= Empty_Node
690 and then
691 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
692 return In_Tree.Project_Nodes.Table (Node).Field2;
693 end First_Case_Item_Of;
695 ---------------------
696 -- First_Choice_Of --
697 ---------------------
699 function First_Choice_Of
700 (Node : Project_Node_Id;
701 In_Tree : Project_Node_Tree_Ref)
702 return Project_Node_Id
704 begin
705 pragma Assert
706 (Node /= Empty_Node
707 and then
708 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
709 return In_Tree.Project_Nodes.Table (Node).Field1;
710 end First_Choice_Of;
712 -------------------------
713 -- First_Comment_After --
714 -------------------------
716 function First_Comment_After
717 (Node : Project_Node_Id;
718 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
720 Zone : Project_Node_Id := Empty_Node;
721 begin
722 pragma Assert (Node /= Empty_Node);
723 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
725 if Zone = Empty_Node then
726 return Empty_Node;
728 else
729 return In_Tree.Project_Nodes.Table (Zone).Field2;
730 end if;
731 end First_Comment_After;
733 -----------------------------
734 -- First_Comment_After_End --
735 -----------------------------
737 function First_Comment_After_End
738 (Node : Project_Node_Id;
739 In_Tree : Project_Node_Tree_Ref)
740 return Project_Node_Id
742 Zone : Project_Node_Id := Empty_Node;
744 begin
745 pragma Assert (Node /= Empty_Node);
746 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
748 if Zone = Empty_Node then
749 return Empty_Node;
751 else
752 return In_Tree.Project_Nodes.Table (Zone).Comments;
753 end if;
754 end First_Comment_After_End;
756 --------------------------
757 -- First_Comment_Before --
758 --------------------------
760 function First_Comment_Before
761 (Node : Project_Node_Id;
762 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
764 Zone : Project_Node_Id := Empty_Node;
766 begin
767 pragma Assert (Node /= Empty_Node);
768 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
770 if Zone = Empty_Node then
771 return Empty_Node;
773 else
774 return In_Tree.Project_Nodes.Table (Zone).Field1;
775 end if;
776 end First_Comment_Before;
778 ------------------------------
779 -- First_Comment_Before_End --
780 ------------------------------
782 function First_Comment_Before_End
783 (Node : Project_Node_Id;
784 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
786 Zone : Project_Node_Id := Empty_Node;
788 begin
789 pragma Assert (Node /= Empty_Node);
790 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
792 if Zone = Empty_Node then
793 return Empty_Node;
795 else
796 return In_Tree.Project_Nodes.Table (Zone).Field3;
797 end if;
798 end First_Comment_Before_End;
800 -------------------------------
801 -- First_Declarative_Item_Of --
802 -------------------------------
804 function First_Declarative_Item_Of
805 (Node : Project_Node_Id;
806 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
808 begin
809 pragma Assert
810 (Node /= Empty_Node
811 and then
812 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
813 or else
814 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
815 or else
816 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
818 if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
819 return In_Tree.Project_Nodes.Table (Node).Field1;
820 else
821 return In_Tree.Project_Nodes.Table (Node).Field2;
822 end if;
823 end First_Declarative_Item_Of;
825 ------------------------------
826 -- First_Expression_In_List --
827 ------------------------------
829 function First_Expression_In_List
830 (Node : Project_Node_Id;
831 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
833 begin
834 pragma Assert
835 (Node /= Empty_Node
836 and then
837 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
838 return In_Tree.Project_Nodes.Table (Node).Field1;
839 end First_Expression_In_List;
841 --------------------------
842 -- First_Literal_String --
843 --------------------------
845 function First_Literal_String
846 (Node : Project_Node_Id;
847 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
849 begin
850 pragma Assert
851 (Node /= Empty_Node
852 and then
853 In_Tree.Project_Nodes.Table (Node).Kind =
854 N_String_Type_Declaration);
855 return In_Tree.Project_Nodes.Table (Node).Field1;
856 end First_Literal_String;
858 ----------------------
859 -- First_Package_Of --
860 ----------------------
862 function First_Package_Of
863 (Node : Project_Node_Id;
864 In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id
866 begin
867 pragma Assert
868 (Node /= Empty_Node
869 and then
870 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
871 return In_Tree.Project_Nodes.Table (Node).Packages;
872 end First_Package_Of;
874 --------------------------
875 -- First_String_Type_Of --
876 --------------------------
878 function First_String_Type_Of
879 (Node : Project_Node_Id;
880 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
882 begin
883 pragma Assert
884 (Node /= Empty_Node
885 and then
886 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
887 return In_Tree.Project_Nodes.Table (Node).Field3;
888 end First_String_Type_Of;
890 ----------------
891 -- First_Term --
892 ----------------
894 function First_Term
895 (Node : Project_Node_Id;
896 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
898 begin
899 pragma Assert
900 (Node /= Empty_Node
901 and then
902 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
903 return In_Tree.Project_Nodes.Table (Node).Field1;
904 end First_Term;
906 -----------------------
907 -- First_Variable_Of --
908 -----------------------
910 function First_Variable_Of
911 (Node : Project_Node_Id;
912 In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id
914 begin
915 pragma Assert
916 (Node /= Empty_Node
917 and then
918 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
919 or else
920 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
922 return In_Tree.Project_Nodes.Table (Node).Variables;
923 end First_Variable_Of;
925 --------------------------
926 -- First_With_Clause_Of --
927 --------------------------
929 function First_With_Clause_Of
930 (Node : Project_Node_Id;
931 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
933 begin
934 pragma Assert
935 (Node /= Empty_Node
936 and then
937 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
938 return In_Tree.Project_Nodes.Table (Node).Field1;
939 end First_With_Clause_Of;
941 ------------------------
942 -- Follows_Empty_Line --
943 ------------------------
945 function Follows_Empty_Line
946 (Node : Project_Node_Id;
947 In_Tree : Project_Node_Tree_Ref) return Boolean is
948 begin
949 pragma Assert
950 (Node /= Empty_Node
951 and then
952 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
953 return In_Tree.Project_Nodes.Table (Node).Flag1;
954 end Follows_Empty_Line;
956 ----------
957 -- Hash --
958 ----------
960 function Hash (N : Project_Node_Id) return Header_Num is
961 begin
962 return Header_Num (N mod Project_Node_Id (Header_Num'Last));
963 end Hash;
965 ----------------
966 -- Initialize --
967 ----------------
969 procedure Initialize (Tree : Project_Node_Tree_Ref) is
970 begin
971 Project_Node_Table.Init (Tree.Project_Nodes);
972 Projects_Htable.Reset (Tree.Projects_HT);
973 end Initialize;
975 -------------------------------
976 -- Is_Followed_By_Empty_Line --
977 -------------------------------
979 function Is_Followed_By_Empty_Line
980 (Node : Project_Node_Id;
981 In_Tree : Project_Node_Tree_Ref) return Boolean
983 begin
984 pragma Assert
985 (Node /= Empty_Node
986 and then
987 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
988 return In_Tree.Project_Nodes.Table (Node).Flag2;
989 end Is_Followed_By_Empty_Line;
991 ----------------------
992 -- Is_Extending_All --
993 ----------------------
995 function Is_Extending_All
996 (Node : Project_Node_Id;
997 In_Tree : Project_Node_Tree_Ref) return Boolean is
998 begin
999 pragma Assert
1000 (Node /= Empty_Node
1001 and then
1002 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1003 or else
1004 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1005 return In_Tree.Project_Nodes.Table (Node).Flag2;
1006 end Is_Extending_All;
1008 -------------------------
1009 -- Is_Not_Last_In_List --
1010 -------------------------
1012 function Is_Not_Last_In_List
1013 (Node : Project_Node_Id;
1014 In_Tree : Project_Node_Tree_Ref) return Boolean is
1015 begin
1016 pragma Assert
1017 (Node /= Empty_Node
1018 and then
1019 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1020 return In_Tree.Project_Nodes.Table (Node).Flag1;
1021 end Is_Not_Last_In_List;
1023 -------------------------------------
1024 -- Imported_Or_Extended_Project_Of --
1025 -------------------------------------
1027 function Imported_Or_Extended_Project_Of
1028 (Project : Project_Node_Id;
1029 In_Tree : Project_Node_Tree_Ref;
1030 With_Name : Name_Id) return Project_Node_Id
1032 With_Clause : Project_Node_Id :=
1033 First_With_Clause_Of (Project, In_Tree);
1034 Result : Project_Node_Id := Empty_Node;
1036 begin
1037 -- First check all the imported projects
1039 while With_Clause /= Empty_Node loop
1041 -- Only non limited imported project may be used as prefix
1042 -- of variable or attributes.
1044 Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree);
1045 exit when Result /= Empty_Node
1046 and then Name_Of (Result, In_Tree) = With_Name;
1047 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1048 end loop;
1050 -- If it is not an imported project, it might be the imported project
1052 if With_Clause = Empty_Node then
1053 Result :=
1054 Extended_Project_Of
1055 (Project_Declaration_Of (Project, In_Tree), In_Tree);
1057 if Result /= Empty_Node
1058 and then Name_Of (Result, In_Tree) /= With_Name
1059 then
1060 Result := Empty_Node;
1061 end if;
1062 end if;
1064 return Result;
1065 end Imported_Or_Extended_Project_Of;
1067 -------------
1068 -- Kind_Of --
1069 -------------
1071 function Kind_Of
1072 (Node : Project_Node_Id;
1073 In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind is
1074 begin
1075 pragma Assert (Node /= Empty_Node);
1076 return In_Tree.Project_Nodes.Table (Node).Kind;
1077 end Kind_Of;
1079 -----------------
1080 -- Location_Of --
1081 -----------------
1083 function Location_Of
1084 (Node : Project_Node_Id;
1085 In_Tree : Project_Node_Tree_Ref) return Source_Ptr is
1086 begin
1087 pragma Assert (Node /= Empty_Node);
1088 return In_Tree.Project_Nodes.Table (Node).Location;
1089 end Location_Of;
1091 -------------
1092 -- Name_Of --
1093 -------------
1095 function Name_Of
1096 (Node : Project_Node_Id;
1097 In_Tree : Project_Node_Tree_Ref) return Name_Id is
1098 begin
1099 pragma Assert (Node /= Empty_Node);
1100 return In_Tree.Project_Nodes.Table (Node).Name;
1101 end Name_Of;
1103 --------------------
1104 -- Next_Case_Item --
1105 --------------------
1107 function Next_Case_Item
1108 (Node : Project_Node_Id;
1109 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1111 begin
1112 pragma Assert
1113 (Node /= Empty_Node
1114 and then
1115 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1116 return In_Tree.Project_Nodes.Table (Node).Field3;
1117 end Next_Case_Item;
1119 ------------------
1120 -- Next_Comment --
1121 ------------------
1123 function Next_Comment
1124 (Node : Project_Node_Id;
1125 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is
1126 begin
1127 pragma Assert
1128 (Node /= Empty_Node
1129 and then
1130 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1131 return In_Tree.Project_Nodes.Table (Node).Comments;
1132 end Next_Comment;
1134 ---------------------------
1135 -- Next_Declarative_Item --
1136 ---------------------------
1138 function Next_Declarative_Item
1139 (Node : Project_Node_Id;
1140 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1142 begin
1143 pragma Assert
1144 (Node /= Empty_Node
1145 and then
1146 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1147 return In_Tree.Project_Nodes.Table (Node).Field2;
1148 end Next_Declarative_Item;
1150 -----------------------------
1151 -- Next_Expression_In_List --
1152 -----------------------------
1154 function Next_Expression_In_List
1155 (Node : Project_Node_Id;
1156 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1158 begin
1159 pragma Assert
1160 (Node /= Empty_Node
1161 and then
1162 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
1163 return In_Tree.Project_Nodes.Table (Node).Field2;
1164 end Next_Expression_In_List;
1166 -------------------------
1167 -- Next_Literal_String --
1168 -------------------------
1170 function Next_Literal_String
1171 (Node : Project_Node_Id;
1172 In_Tree : Project_Node_Tree_Ref)
1173 return Project_Node_Id
1175 begin
1176 pragma Assert
1177 (Node /= Empty_Node
1178 and then
1179 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
1180 return In_Tree.Project_Nodes.Table (Node).Field1;
1181 end Next_Literal_String;
1183 -----------------------------
1184 -- Next_Package_In_Project --
1185 -----------------------------
1187 function Next_Package_In_Project
1188 (Node : Project_Node_Id;
1189 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1191 begin
1192 pragma Assert
1193 (Node /= Empty_Node
1194 and then
1195 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1196 return In_Tree.Project_Nodes.Table (Node).Field3;
1197 end Next_Package_In_Project;
1199 ----------------------
1200 -- Next_String_Type --
1201 ----------------------
1203 function Next_String_Type
1204 (Node : Project_Node_Id;
1205 In_Tree : Project_Node_Tree_Ref)
1206 return Project_Node_Id
1208 begin
1209 pragma Assert
1210 (Node /= Empty_Node
1211 and then
1212 In_Tree.Project_Nodes.Table (Node).Kind =
1213 N_String_Type_Declaration);
1214 return In_Tree.Project_Nodes.Table (Node).Field2;
1215 end Next_String_Type;
1217 ---------------
1218 -- Next_Term --
1219 ---------------
1221 function Next_Term
1222 (Node : Project_Node_Id;
1223 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1225 begin
1226 pragma Assert
1227 (Node /= Empty_Node
1228 and then
1229 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1230 return In_Tree.Project_Nodes.Table (Node).Field2;
1231 end Next_Term;
1233 -------------------
1234 -- Next_Variable --
1235 -------------------
1237 function Next_Variable
1238 (Node : Project_Node_Id;
1239 In_Tree : Project_Node_Tree_Ref)
1240 return Project_Node_Id
1242 begin
1243 pragma Assert
1244 (Node /= Empty_Node
1245 and then
1246 (In_Tree.Project_Nodes.Table (Node).Kind =
1247 N_Typed_Variable_Declaration
1248 or else
1249 In_Tree.Project_Nodes.Table (Node).Kind =
1250 N_Variable_Declaration));
1252 return In_Tree.Project_Nodes.Table (Node).Field3;
1253 end Next_Variable;
1255 -------------------------
1256 -- Next_With_Clause_Of --
1257 -------------------------
1259 function Next_With_Clause_Of
1260 (Node : Project_Node_Id;
1261 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1263 begin
1264 pragma Assert
1265 (Node /= Empty_Node
1266 and then
1267 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1268 return In_Tree.Project_Nodes.Table (Node).Field2;
1269 end Next_With_Clause_Of;
1271 ---------------------------------
1272 -- Non_Limited_Project_Node_Of --
1273 ---------------------------------
1275 function Non_Limited_Project_Node_Of
1276 (Node : Project_Node_Id;
1277 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1279 begin
1280 pragma Assert
1281 (Node /= Empty_Node
1282 and then
1283 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1284 return In_Tree.Project_Nodes.Table (Node).Field3;
1285 end Non_Limited_Project_Node_Of;
1287 -------------------
1288 -- Package_Id_Of --
1289 -------------------
1291 function Package_Id_Of
1292 (Node : Project_Node_Id;
1293 In_Tree : Project_Node_Tree_Ref) return Package_Node_Id
1295 begin
1296 pragma Assert
1297 (Node /= Empty_Node
1298 and then
1299 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1300 return In_Tree.Project_Nodes.Table (Node).Pkg_Id;
1301 end Package_Id_Of;
1303 ---------------------
1304 -- Package_Node_Of --
1305 ---------------------
1307 function Package_Node_Of
1308 (Node : Project_Node_Id;
1309 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1311 begin
1312 pragma Assert
1313 (Node /= Empty_Node
1314 and then
1315 (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1316 or else
1317 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1318 return In_Tree.Project_Nodes.Table (Node).Field2;
1319 end Package_Node_Of;
1321 ------------------
1322 -- Path_Name_Of --
1323 ------------------
1325 function Path_Name_Of
1326 (Node : Project_Node_Id;
1327 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
1329 begin
1330 pragma Assert
1331 (Node /= Empty_Node
1332 and then
1333 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1334 or else
1335 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1336 return In_Tree.Project_Nodes.Table (Node).Path_Name;
1337 end Path_Name_Of;
1339 ----------------------------
1340 -- Project_Declaration_Of --
1341 ----------------------------
1343 function Project_Declaration_Of
1344 (Node : Project_Node_Id;
1345 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1347 begin
1348 pragma Assert
1349 (Node /= Empty_Node
1350 and then
1351 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1352 return In_Tree.Project_Nodes.Table (Node).Field2;
1353 end Project_Declaration_Of;
1355 -------------------------------------------
1356 -- Project_File_Includes_Unkept_Comments --
1357 -------------------------------------------
1359 function Project_File_Includes_Unkept_Comments
1360 (Node : Project_Node_Id;
1361 In_Tree : Project_Node_Tree_Ref) return Boolean
1363 Declaration : constant Project_Node_Id :=
1364 Project_Declaration_Of (Node, In_Tree);
1365 begin
1366 return In_Tree.Project_Nodes.Table (Declaration).Flag1;
1367 end Project_File_Includes_Unkept_Comments;
1369 ---------------------
1370 -- Project_Node_Of --
1371 ---------------------
1373 function Project_Node_Of
1374 (Node : Project_Node_Id;
1375 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1377 begin
1378 pragma Assert
1379 (Node /= Empty_Node
1380 and then
1381 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
1382 or else
1383 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1384 or else
1385 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1386 return In_Tree.Project_Nodes.Table (Node).Field1;
1387 end Project_Node_Of;
1389 -----------------------------------
1390 -- Project_Of_Renamed_Package_Of --
1391 -----------------------------------
1393 function Project_Of_Renamed_Package_Of
1394 (Node : Project_Node_Id;
1395 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1397 begin
1398 pragma Assert
1399 (Node /= Empty_Node
1400 and then
1401 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1402 return In_Tree.Project_Nodes.Table (Node).Field1;
1403 end Project_Of_Renamed_Package_Of;
1405 --------------------------
1406 -- Remove_Next_End_Node --
1407 --------------------------
1409 procedure Remove_Next_End_Node is
1410 begin
1411 Next_End_Nodes.Decrement_Last;
1412 end Remove_Next_End_Node;
1414 -----------------
1415 -- Reset_State --
1416 -----------------
1418 procedure Reset_State is
1419 begin
1420 End_Of_Line_Node := Empty_Node;
1421 Previous_Line_Node := Empty_Node;
1422 Previous_End_Node := Empty_Node;
1423 Unkept_Comments := False;
1424 Comments.Set_Last (0);
1425 end Reset_State;
1427 -------------
1428 -- Restore --
1429 -------------
1431 procedure Restore (S : Comment_State) is
1432 begin
1433 End_Of_Line_Node := S.End_Of_Line_Node;
1434 Previous_Line_Node := S.Previous_Line_Node;
1435 Previous_End_Node := S.Previous_End_Node;
1436 Next_End_Nodes.Set_Last (0);
1437 Unkept_Comments := S.Unkept_Comments;
1439 Comments.Set_Last (0);
1441 for J in S.Comments'Range loop
1442 Comments.Increment_Last;
1443 Comments.Table (Comments.Last) := S.Comments (J);
1444 end loop;
1445 end Restore;
1447 ----------
1448 -- Save --
1449 ----------
1451 procedure Save (S : out Comment_State) is
1452 Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last);
1454 begin
1455 for J in 1 .. Comments.Last loop
1456 Cmts (J) := Comments.Table (J);
1457 end loop;
1459 S :=
1460 (End_Of_Line_Node => End_Of_Line_Node,
1461 Previous_Line_Node => Previous_Line_Node,
1462 Previous_End_Node => Previous_End_Node,
1463 Unkept_Comments => Unkept_Comments,
1464 Comments => Cmts);
1465 end Save;
1467 ----------
1468 -- Scan --
1469 ----------
1471 procedure Scan (In_Tree : Project_Node_Tree_Ref) is
1472 Empty_Line : Boolean := False;
1474 begin
1475 -- If there are comments, then they will not be kept. Set the flag and
1476 -- clear the comments.
1478 if Comments.Last > 0 then
1479 Unkept_Comments := True;
1480 Comments.Set_Last (0);
1481 end if;
1483 -- Loop until a token other that End_Of_Line or Comment is found
1485 loop
1486 Prj.Err.Scanner.Scan;
1488 case Token is
1489 when Tok_End_Of_Line =>
1490 if Prev_Token = Tok_End_Of_Line then
1491 Empty_Line := True;
1493 if Comments.Last > 0 then
1494 Comments.Table (Comments.Last).Is_Followed_By_Empty_Line
1495 := True;
1496 end if;
1497 end if;
1499 when Tok_Comment =>
1500 -- If this is a line comment, add it to the comment table
1502 if Prev_Token = Tok_End_Of_Line
1503 or else Prev_Token = No_Token
1504 then
1505 Comments.Increment_Last;
1506 Comments.Table (Comments.Last) :=
1507 (Value => Comment_Id,
1508 Follows_Empty_Line => Empty_Line,
1509 Is_Followed_By_Empty_Line => False);
1511 -- Otherwise, it is an end of line comment. If there is
1512 -- an end of line node specified, associate the comment with
1513 -- this node.
1515 elsif End_Of_Line_Node /= Empty_Node then
1516 declare
1517 Zones : constant Project_Node_Id :=
1518 Comment_Zones_Of (End_Of_Line_Node, In_Tree);
1519 begin
1520 In_Tree.Project_Nodes.Table (Zones).Value := Comment_Id;
1521 end;
1523 -- Otherwise, this end of line node cannot be kept
1525 else
1526 Unkept_Comments := True;
1527 Comments.Set_Last (0);
1528 end if;
1530 Empty_Line := False;
1532 when others =>
1533 -- If there are comments, where the first comment is not
1534 -- following an empty line, put the initial uninterrupted
1535 -- comment zone with the node of the preceding line (either
1536 -- a Previous_Line or a Previous_End node), if any.
1538 if Comments.Last > 0 and then
1539 not Comments.Table (1).Follows_Empty_Line then
1540 if Previous_Line_Node /= Empty_Node then
1541 Add_Comments
1542 (To => Previous_Line_Node,
1543 Where => After,
1544 In_Tree => In_Tree);
1546 elsif Previous_End_Node /= Empty_Node then
1547 Add_Comments
1548 (To => Previous_End_Node,
1549 Where => After_End,
1550 In_Tree => In_Tree);
1551 end if;
1552 end if;
1554 -- If there are still comments and the token is "end", then
1555 -- put these comments with the Next_End node, if any;
1556 -- otherwise, these comments cannot be kept. Always clear
1557 -- the comments.
1559 if Comments.Last > 0 and then Token = Tok_End then
1560 if Next_End_Nodes.Last > 0 then
1561 Add_Comments
1562 (To => Next_End_Nodes.Table (Next_End_Nodes.Last),
1563 Where => Before_End,
1564 In_Tree => In_Tree);
1566 else
1567 Unkept_Comments := True;
1568 end if;
1570 Comments.Set_Last (0);
1571 end if;
1573 -- Reset the End_Of_Line, Previous_Line and Previous_End nodes
1574 -- so that they are not used again.
1576 End_Of_Line_Node := Empty_Node;
1577 Previous_Line_Node := Empty_Node;
1578 Previous_End_Node := Empty_Node;
1580 -- And return
1582 exit;
1583 end case;
1584 end loop;
1585 end Scan;
1587 ------------------------------------
1588 -- Set_Associative_Array_Index_Of --
1589 ------------------------------------
1591 procedure Set_Associative_Array_Index_Of
1592 (Node : Project_Node_Id;
1593 In_Tree : Project_Node_Tree_Ref;
1594 To : Name_Id)
1596 begin
1597 pragma Assert
1598 (Node /= Empty_Node
1599 and then
1600 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1601 or else
1602 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1603 In_Tree.Project_Nodes.Table (Node).Value := To;
1604 end Set_Associative_Array_Index_Of;
1606 --------------------------------
1607 -- Set_Associative_Package_Of --
1608 --------------------------------
1610 procedure Set_Associative_Package_Of
1611 (Node : Project_Node_Id;
1612 In_Tree : Project_Node_Tree_Ref;
1613 To : Project_Node_Id)
1615 begin
1616 pragma Assert
1617 (Node /= Empty_Node
1618 and then
1619 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
1620 In_Tree.Project_Nodes.Table (Node).Field3 := To;
1621 end Set_Associative_Package_Of;
1623 --------------------------------
1624 -- Set_Associative_Project_Of --
1625 --------------------------------
1627 procedure Set_Associative_Project_Of
1628 (Node : Project_Node_Id;
1629 In_Tree : Project_Node_Tree_Ref;
1630 To : Project_Node_Id)
1632 begin
1633 pragma Assert
1634 (Node /= Empty_Node
1635 and then
1636 (In_Tree.Project_Nodes.Table (Node).Kind =
1637 N_Attribute_Declaration));
1638 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1639 end Set_Associative_Project_Of;
1641 --------------------------
1642 -- Set_Case_Insensitive --
1643 --------------------------
1645 procedure Set_Case_Insensitive
1646 (Node : Project_Node_Id;
1647 In_Tree : Project_Node_Tree_Ref;
1648 To : Boolean)
1650 begin
1651 pragma Assert
1652 (Node /= Empty_Node
1653 and then
1654 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1655 or else
1656 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1657 In_Tree.Project_Nodes.Table (Node).Flag1 := To;
1658 end Set_Case_Insensitive;
1660 ------------------------------------
1661 -- Set_Case_Variable_Reference_Of --
1662 ------------------------------------
1664 procedure Set_Case_Variable_Reference_Of
1665 (Node : Project_Node_Id;
1666 In_Tree : Project_Node_Tree_Ref;
1667 To : Project_Node_Id)
1669 begin
1670 pragma Assert
1671 (Node /= Empty_Node
1672 and then
1673 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1674 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1675 end Set_Case_Variable_Reference_Of;
1677 ---------------------------
1678 -- Set_Current_Item_Node --
1679 ---------------------------
1681 procedure Set_Current_Item_Node
1682 (Node : Project_Node_Id;
1683 In_Tree : Project_Node_Tree_Ref;
1684 To : Project_Node_Id)
1686 begin
1687 pragma Assert
1688 (Node /= Empty_Node
1689 and then
1690 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1691 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1692 end Set_Current_Item_Node;
1694 ----------------------
1695 -- Set_Current_Term --
1696 ----------------------
1698 procedure Set_Current_Term
1699 (Node : Project_Node_Id;
1700 In_Tree : Project_Node_Tree_Ref;
1701 To : Project_Node_Id)
1703 begin
1704 pragma Assert
1705 (Node /= Empty_Node
1706 and then
1707 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1708 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1709 end Set_Current_Term;
1711 ----------------------
1712 -- Set_Directory_Of --
1713 ----------------------
1715 procedure Set_Directory_Of
1716 (Node : Project_Node_Id;
1717 In_Tree : Project_Node_Tree_Ref;
1718 To : Path_Name_Type)
1720 begin
1721 pragma Assert
1722 (Node /= Empty_Node
1723 and then
1724 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1725 In_Tree.Project_Nodes.Table (Node).Directory := To;
1726 end Set_Directory_Of;
1728 ---------------------
1729 -- Set_End_Of_Line --
1730 ---------------------
1732 procedure Set_End_Of_Line (To : Project_Node_Id) is
1733 begin
1734 End_Of_Line_Node := To;
1735 end Set_End_Of_Line;
1737 ----------------------------
1738 -- Set_Expression_Kind_Of --
1739 ----------------------------
1741 procedure Set_Expression_Kind_Of
1742 (Node : Project_Node_Id;
1743 In_Tree : Project_Node_Tree_Ref;
1744 To : Variable_Kind)
1746 begin
1747 pragma Assert
1748 (Node /= Empty_Node
1749 and then
1750 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
1751 or else
1752 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1753 or else
1754 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
1755 or else
1756 In_Tree.Project_Nodes.Table (Node).Kind =
1757 N_Typed_Variable_Declaration
1758 or else
1759 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
1760 or else
1761 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
1762 or else
1763 In_Tree.Project_Nodes.Table (Node).Kind = N_Term
1764 or else
1765 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1766 or else
1767 In_Tree.Project_Nodes.Table (Node).Kind =
1768 N_Attribute_Reference));
1769 In_Tree.Project_Nodes.Table (Node).Expr_Kind := To;
1770 end Set_Expression_Kind_Of;
1772 -----------------------
1773 -- Set_Expression_Of --
1774 -----------------------
1776 procedure Set_Expression_Of
1777 (Node : Project_Node_Id;
1778 In_Tree : Project_Node_Tree_Ref;
1779 To : Project_Node_Id)
1781 begin
1782 pragma Assert
1783 (Node /= Empty_Node
1784 and then
1785 (In_Tree.Project_Nodes.Table (Node).Kind =
1786 N_Attribute_Declaration
1787 or else
1788 In_Tree.Project_Nodes.Table (Node).Kind =
1789 N_Typed_Variable_Declaration
1790 or else
1791 In_Tree.Project_Nodes.Table (Node).Kind =
1792 N_Variable_Declaration));
1793 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1794 end Set_Expression_Of;
1796 -------------------------------
1797 -- Set_External_Reference_Of --
1798 -------------------------------
1800 procedure Set_External_Reference_Of
1801 (Node : Project_Node_Id;
1802 In_Tree : Project_Node_Tree_Ref;
1803 To : Project_Node_Id)
1805 begin
1806 pragma Assert
1807 (Node /= Empty_Node
1808 and then
1809 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
1810 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1811 end Set_External_Reference_Of;
1813 -----------------------------
1814 -- Set_External_Default_Of --
1815 -----------------------------
1817 procedure Set_External_Default_Of
1818 (Node : Project_Node_Id;
1819 In_Tree : Project_Node_Tree_Ref;
1820 To : Project_Node_Id)
1822 begin
1823 pragma Assert
1824 (Node /= Empty_Node
1825 and then
1826 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
1827 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1828 end Set_External_Default_Of;
1830 ----------------------------
1831 -- Set_First_Case_Item_Of --
1832 ----------------------------
1834 procedure Set_First_Case_Item_Of
1835 (Node : Project_Node_Id;
1836 In_Tree : Project_Node_Tree_Ref;
1837 To : Project_Node_Id)
1839 begin
1840 pragma Assert
1841 (Node /= Empty_Node
1842 and then
1843 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1844 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1845 end Set_First_Case_Item_Of;
1847 -------------------------
1848 -- Set_First_Choice_Of --
1849 -------------------------
1851 procedure Set_First_Choice_Of
1852 (Node : Project_Node_Id;
1853 In_Tree : Project_Node_Tree_Ref;
1854 To : Project_Node_Id)
1856 begin
1857 pragma Assert
1858 (Node /= Empty_Node
1859 and then
1860 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1861 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1862 end Set_First_Choice_Of;
1864 -----------------------------
1865 -- Set_First_Comment_After --
1866 -----------------------------
1868 procedure Set_First_Comment_After
1869 (Node : Project_Node_Id;
1870 In_Tree : Project_Node_Tree_Ref;
1871 To : Project_Node_Id)
1873 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1874 begin
1875 In_Tree.Project_Nodes.Table (Zone).Field2 := To;
1876 end Set_First_Comment_After;
1878 ---------------------------------
1879 -- Set_First_Comment_After_End --
1880 ---------------------------------
1882 procedure Set_First_Comment_After_End
1883 (Node : Project_Node_Id;
1884 In_Tree : Project_Node_Tree_Ref;
1885 To : Project_Node_Id)
1887 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1888 begin
1889 In_Tree.Project_Nodes.Table (Zone).Comments := To;
1890 end Set_First_Comment_After_End;
1892 ------------------------------
1893 -- Set_First_Comment_Before --
1894 ------------------------------
1896 procedure Set_First_Comment_Before
1897 (Node : Project_Node_Id;
1898 In_Tree : Project_Node_Tree_Ref;
1899 To : Project_Node_Id)
1902 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1903 begin
1904 In_Tree.Project_Nodes.Table (Zone).Field1 := To;
1905 end Set_First_Comment_Before;
1907 ----------------------------------
1908 -- Set_First_Comment_Before_End --
1909 ----------------------------------
1911 procedure Set_First_Comment_Before_End
1912 (Node : Project_Node_Id;
1913 In_Tree : Project_Node_Tree_Ref;
1914 To : Project_Node_Id)
1916 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1917 begin
1918 In_Tree.Project_Nodes.Table (Zone).Field2 := To;
1919 end Set_First_Comment_Before_End;
1921 ------------------------
1922 -- Set_Next_Case_Item --
1923 ------------------------
1925 procedure Set_Next_Case_Item
1926 (Node : Project_Node_Id;
1927 In_Tree : Project_Node_Tree_Ref;
1928 To : Project_Node_Id)
1930 begin
1931 pragma Assert
1932 (Node /= Empty_Node
1933 and then
1934 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1935 In_Tree.Project_Nodes.Table (Node).Field3 := To;
1936 end Set_Next_Case_Item;
1938 ----------------------
1939 -- Set_Next_Comment --
1940 ----------------------
1942 procedure Set_Next_Comment
1943 (Node : Project_Node_Id;
1944 In_Tree : Project_Node_Tree_Ref;
1945 To : Project_Node_Id)
1947 begin
1948 pragma Assert
1949 (Node /= Empty_Node
1950 and then
1951 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1952 In_Tree.Project_Nodes.Table (Node).Comments := To;
1953 end Set_Next_Comment;
1955 -----------------------------------
1956 -- Set_First_Declarative_Item_Of --
1957 -----------------------------------
1959 procedure Set_First_Declarative_Item_Of
1960 (Node : Project_Node_Id;
1961 In_Tree : Project_Node_Tree_Ref;
1962 To : Project_Node_Id)
1964 begin
1965 pragma Assert
1966 (Node /= Empty_Node
1967 and then
1968 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
1969 or else
1970 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
1971 or else
1972 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
1974 if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
1975 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1976 else
1977 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1978 end if;
1979 end Set_First_Declarative_Item_Of;
1981 ----------------------------------
1982 -- Set_First_Expression_In_List --
1983 ----------------------------------
1985 procedure Set_First_Expression_In_List
1986 (Node : Project_Node_Id;
1987 In_Tree : Project_Node_Tree_Ref;
1988 To : Project_Node_Id)
1990 begin
1991 pragma Assert
1992 (Node /= Empty_Node
1993 and then
1994 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
1995 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1996 end Set_First_Expression_In_List;
1998 ------------------------------
1999 -- Set_First_Literal_String --
2000 ------------------------------
2002 procedure Set_First_Literal_String
2003 (Node : Project_Node_Id;
2004 In_Tree : Project_Node_Tree_Ref;
2005 To : Project_Node_Id)
2007 begin
2008 pragma Assert
2009 (Node /= Empty_Node
2010 and then
2011 In_Tree.Project_Nodes.Table (Node).Kind =
2012 N_String_Type_Declaration);
2013 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2014 end Set_First_Literal_String;
2016 --------------------------
2017 -- Set_First_Package_Of --
2018 --------------------------
2020 procedure Set_First_Package_Of
2021 (Node : Project_Node_Id;
2022 In_Tree : Project_Node_Tree_Ref;
2023 To : Package_Declaration_Id)
2025 begin
2026 pragma Assert
2027 (Node /= Empty_Node
2028 and then
2029 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2030 In_Tree.Project_Nodes.Table (Node).Packages := To;
2031 end Set_First_Package_Of;
2033 ------------------------------
2034 -- Set_First_String_Type_Of --
2035 ------------------------------
2037 procedure Set_First_String_Type_Of
2038 (Node : Project_Node_Id;
2039 In_Tree : Project_Node_Tree_Ref;
2040 To : Project_Node_Id)
2042 begin
2043 pragma Assert
2044 (Node /= Empty_Node
2045 and then
2046 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2047 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2048 end Set_First_String_Type_Of;
2050 --------------------
2051 -- Set_First_Term --
2052 --------------------
2054 procedure Set_First_Term
2055 (Node : Project_Node_Id;
2056 In_Tree : Project_Node_Tree_Ref;
2057 To : Project_Node_Id)
2059 begin
2060 pragma Assert
2061 (Node /= Empty_Node
2062 and then
2063 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2064 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2065 end Set_First_Term;
2067 ---------------------------
2068 -- Set_First_Variable_Of --
2069 ---------------------------
2071 procedure Set_First_Variable_Of
2072 (Node : Project_Node_Id;
2073 In_Tree : Project_Node_Tree_Ref;
2074 To : Variable_Node_Id)
2076 begin
2077 pragma Assert
2078 (Node /= Empty_Node
2079 and then
2080 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2081 or else
2082 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2083 In_Tree.Project_Nodes.Table (Node).Variables := To;
2084 end Set_First_Variable_Of;
2086 ------------------------------
2087 -- Set_First_With_Clause_Of --
2088 ------------------------------
2090 procedure Set_First_With_Clause_Of
2091 (Node : Project_Node_Id;
2092 In_Tree : Project_Node_Tree_Ref;
2093 To : Project_Node_Id)
2095 begin
2096 pragma Assert
2097 (Node /= Empty_Node
2098 and then
2099 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2100 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2101 end Set_First_With_Clause_Of;
2103 --------------------------
2104 -- Set_Is_Extending_All --
2105 --------------------------
2107 procedure Set_Is_Extending_All
2108 (Node : Project_Node_Id;
2109 In_Tree : Project_Node_Tree_Ref)
2111 begin
2112 pragma Assert
2113 (Node /= Empty_Node
2114 and then
2115 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2116 or else
2117 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2118 In_Tree.Project_Nodes.Table (Node).Flag2 := True;
2119 end Set_Is_Extending_All;
2121 -----------------------------
2122 -- Set_Is_Not_Last_In_List --
2123 -----------------------------
2125 procedure Set_Is_Not_Last_In_List
2126 (Node : Project_Node_Id;
2127 In_Tree : Project_Node_Tree_Ref)
2129 begin
2130 pragma Assert
2131 (Node /= Empty_Node
2132 and then
2133 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2134 In_Tree.Project_Nodes.Table (Node).Flag1 := True;
2135 end Set_Is_Not_Last_In_List;
2137 -----------------
2138 -- Set_Kind_Of --
2139 -----------------
2141 procedure Set_Kind_Of
2142 (Node : Project_Node_Id;
2143 In_Tree : Project_Node_Tree_Ref;
2144 To : Project_Node_Kind)
2146 begin
2147 pragma Assert (Node /= Empty_Node);
2148 In_Tree.Project_Nodes.Table (Node).Kind := To;
2149 end Set_Kind_Of;
2151 ---------------------
2152 -- Set_Location_Of --
2153 ---------------------
2155 procedure Set_Location_Of
2156 (Node : Project_Node_Id;
2157 In_Tree : Project_Node_Tree_Ref;
2158 To : Source_Ptr)
2160 begin
2161 pragma Assert (Node /= Empty_Node);
2162 In_Tree.Project_Nodes.Table (Node).Location := To;
2163 end Set_Location_Of;
2165 -----------------------------
2166 -- Set_Extended_Project_Of --
2167 -----------------------------
2169 procedure Set_Extended_Project_Of
2170 (Node : Project_Node_Id;
2171 In_Tree : Project_Node_Tree_Ref;
2172 To : Project_Node_Id)
2174 begin
2175 pragma Assert
2176 (Node /= Empty_Node
2177 and then
2178 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2179 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2180 end Set_Extended_Project_Of;
2182 ----------------------------------
2183 -- Set_Extended_Project_Path_Of --
2184 ----------------------------------
2186 procedure Set_Extended_Project_Path_Of
2187 (Node : Project_Node_Id;
2188 In_Tree : Project_Node_Tree_Ref;
2189 To : Path_Name_Type)
2191 begin
2192 pragma Assert
2193 (Node /= Empty_Node
2194 and then
2195 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2196 In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To);
2197 end Set_Extended_Project_Path_Of;
2199 ------------------------------
2200 -- Set_Extending_Project_Of --
2201 ------------------------------
2203 procedure Set_Extending_Project_Of
2204 (Node : Project_Node_Id;
2205 In_Tree : Project_Node_Tree_Ref;
2206 To : Project_Node_Id)
2208 begin
2209 pragma Assert
2210 (Node /= Empty_Node
2211 and then
2212 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2213 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2214 end Set_Extending_Project_Of;
2216 -----------------
2217 -- Set_Name_Of --
2218 -----------------
2220 procedure Set_Name_Of
2221 (Node : Project_Node_Id;
2222 In_Tree : Project_Node_Tree_Ref;
2223 To : Name_Id)
2225 begin
2226 pragma Assert (Node /= Empty_Node);
2227 In_Tree.Project_Nodes.Table (Node).Name := To;
2228 end Set_Name_Of;
2230 -------------------------------
2231 -- Set_Next_Declarative_Item --
2232 -------------------------------
2234 procedure Set_Next_Declarative_Item
2235 (Node : Project_Node_Id;
2236 In_Tree : Project_Node_Tree_Ref;
2237 To : Project_Node_Id)
2239 begin
2240 pragma Assert
2241 (Node /= Empty_Node
2242 and then
2243 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
2244 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2245 end Set_Next_Declarative_Item;
2247 -----------------------
2248 -- Set_Next_End_Node --
2249 -----------------------
2251 procedure Set_Next_End_Node (To : Project_Node_Id) is
2252 begin
2253 Next_End_Nodes.Increment_Last;
2254 Next_End_Nodes.Table (Next_End_Nodes.Last) := To;
2255 end Set_Next_End_Node;
2257 ---------------------------------
2258 -- Set_Next_Expression_In_List --
2259 ---------------------------------
2261 procedure Set_Next_Expression_In_List
2262 (Node : Project_Node_Id;
2263 In_Tree : Project_Node_Tree_Ref;
2264 To : Project_Node_Id)
2266 begin
2267 pragma Assert
2268 (Node /= Empty_Node
2269 and then
2270 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2271 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2272 end Set_Next_Expression_In_List;
2274 -----------------------------
2275 -- Set_Next_Literal_String --
2276 -----------------------------
2278 procedure Set_Next_Literal_String
2279 (Node : Project_Node_Id;
2280 In_Tree : Project_Node_Tree_Ref;
2281 To : Project_Node_Id)
2283 begin
2284 pragma Assert
2285 (Node /= Empty_Node
2286 and then
2287 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
2288 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2289 end Set_Next_Literal_String;
2291 ---------------------------------
2292 -- Set_Next_Package_In_Project --
2293 ---------------------------------
2295 procedure Set_Next_Package_In_Project
2296 (Node : Project_Node_Id;
2297 In_Tree : Project_Node_Tree_Ref;
2298 To : Project_Node_Id)
2300 begin
2301 pragma Assert
2302 (Node /= Empty_Node
2303 and then
2304 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2305 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2306 end Set_Next_Package_In_Project;
2308 --------------------------
2309 -- Set_Next_String_Type --
2310 --------------------------
2312 procedure Set_Next_String_Type
2313 (Node : Project_Node_Id;
2314 In_Tree : Project_Node_Tree_Ref;
2315 To : Project_Node_Id)
2317 begin
2318 pragma Assert
2319 (Node /= Empty_Node
2320 and then
2321 In_Tree.Project_Nodes.Table (Node).Kind =
2322 N_String_Type_Declaration);
2323 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2324 end Set_Next_String_Type;
2326 -------------------
2327 -- Set_Next_Term --
2328 -------------------
2330 procedure Set_Next_Term
2331 (Node : Project_Node_Id;
2332 In_Tree : Project_Node_Tree_Ref;
2333 To : Project_Node_Id)
2335 begin
2336 pragma Assert
2337 (Node /= Empty_Node
2338 and then
2339 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
2340 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2341 end Set_Next_Term;
2343 -----------------------
2344 -- Set_Next_Variable --
2345 -----------------------
2347 procedure Set_Next_Variable
2348 (Node : Project_Node_Id;
2349 In_Tree : Project_Node_Tree_Ref;
2350 To : Project_Node_Id)
2352 begin
2353 pragma Assert
2354 (Node /= Empty_Node
2355 and then
2356 (In_Tree.Project_Nodes.Table (Node).Kind =
2357 N_Typed_Variable_Declaration
2358 or else
2359 In_Tree.Project_Nodes.Table (Node).Kind =
2360 N_Variable_Declaration));
2361 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2362 end Set_Next_Variable;
2364 -----------------------------
2365 -- Set_Next_With_Clause_Of --
2366 -----------------------------
2368 procedure Set_Next_With_Clause_Of
2369 (Node : Project_Node_Id;
2370 In_Tree : Project_Node_Tree_Ref;
2371 To : Project_Node_Id)
2373 begin
2374 pragma Assert
2375 (Node /= Empty_Node
2376 and then
2377 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2378 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2379 end Set_Next_With_Clause_Of;
2381 -----------------------
2382 -- Set_Package_Id_Of --
2383 -----------------------
2385 procedure Set_Package_Id_Of
2386 (Node : Project_Node_Id;
2387 In_Tree : Project_Node_Tree_Ref;
2388 To : Package_Node_Id)
2390 begin
2391 pragma Assert
2392 (Node /= Empty_Node
2393 and then
2394 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2395 In_Tree.Project_Nodes.Table (Node).Pkg_Id := To;
2396 end Set_Package_Id_Of;
2398 -------------------------
2399 -- Set_Package_Node_Of --
2400 -------------------------
2402 procedure Set_Package_Node_Of
2403 (Node : Project_Node_Id;
2404 In_Tree : Project_Node_Tree_Ref;
2405 To : Project_Node_Id)
2407 begin
2408 pragma Assert
2409 (Node /= Empty_Node
2410 and then
2411 (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2412 or else
2413 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2414 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2415 end Set_Package_Node_Of;
2417 ----------------------
2418 -- Set_Path_Name_Of --
2419 ----------------------
2421 procedure Set_Path_Name_Of
2422 (Node : Project_Node_Id;
2423 In_Tree : Project_Node_Tree_Ref;
2424 To : Path_Name_Type)
2426 begin
2427 pragma Assert
2428 (Node /= Empty_Node
2429 and then
2430 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2431 or else
2432 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2433 In_Tree.Project_Nodes.Table (Node).Path_Name := To;
2434 end Set_Path_Name_Of;
2436 ---------------------------
2437 -- Set_Previous_End_Node --
2438 ---------------------------
2439 procedure Set_Previous_End_Node (To : Project_Node_Id) is
2440 begin
2441 Previous_End_Node := To;
2442 end Set_Previous_End_Node;
2444 ----------------------------
2445 -- Set_Previous_Line_Node --
2446 ----------------------------
2448 procedure Set_Previous_Line_Node (To : Project_Node_Id) is
2449 begin
2450 Previous_Line_Node := To;
2451 end Set_Previous_Line_Node;
2453 --------------------------------
2454 -- Set_Project_Declaration_Of --
2455 --------------------------------
2457 procedure Set_Project_Declaration_Of
2458 (Node : Project_Node_Id;
2459 In_Tree : Project_Node_Tree_Ref;
2460 To : Project_Node_Id)
2462 begin
2463 pragma Assert
2464 (Node /= Empty_Node
2465 and then
2466 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2467 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2468 end Set_Project_Declaration_Of;
2470 -----------------------------------------------
2471 -- Set_Project_File_Includes_Unkept_Comments --
2472 -----------------------------------------------
2474 procedure Set_Project_File_Includes_Unkept_Comments
2475 (Node : Project_Node_Id;
2476 In_Tree : Project_Node_Tree_Ref;
2477 To : Boolean)
2479 Declaration : constant Project_Node_Id :=
2480 Project_Declaration_Of (Node, In_Tree);
2481 begin
2482 In_Tree.Project_Nodes.Table (Declaration).Flag1 := To;
2483 end Set_Project_File_Includes_Unkept_Comments;
2485 -------------------------
2486 -- Set_Project_Node_Of --
2487 -------------------------
2489 procedure Set_Project_Node_Of
2490 (Node : Project_Node_Id;
2491 In_Tree : Project_Node_Tree_Ref;
2492 To : Project_Node_Id;
2493 Limited_With : Boolean := False)
2495 begin
2496 pragma Assert
2497 (Node /= Empty_Node
2498 and then
2499 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2500 or else
2501 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2502 or else
2503 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2504 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2506 if In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2507 and then not Limited_With
2508 then
2509 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2510 end if;
2511 end Set_Project_Node_Of;
2513 ---------------------------------------
2514 -- Set_Project_Of_Renamed_Package_Of --
2515 ---------------------------------------
2517 procedure Set_Project_Of_Renamed_Package_Of
2518 (Node : Project_Node_Id;
2519 In_Tree : Project_Node_Tree_Ref;
2520 To : Project_Node_Id)
2522 begin
2523 pragma Assert
2524 (Node /= Empty_Node
2525 and then
2526 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2527 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2528 end Set_Project_Of_Renamed_Package_Of;
2530 -------------------------
2531 -- Set_Source_Index_Of --
2532 -------------------------
2534 procedure Set_Source_Index_Of
2535 (Node : Project_Node_Id;
2536 In_Tree : Project_Node_Tree_Ref;
2537 To : Int)
2539 begin
2540 pragma Assert
2541 (Node /= Empty_Node
2542 and then
2543 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2544 or else
2545 In_Tree.Project_Nodes.Table (Node).Kind =
2546 N_Attribute_Declaration));
2547 In_Tree.Project_Nodes.Table (Node).Src_Index := To;
2548 end Set_Source_Index_Of;
2550 ------------------------
2551 -- Set_String_Type_Of --
2552 ------------------------
2554 procedure Set_String_Type_Of
2555 (Node : Project_Node_Id;
2556 In_Tree : Project_Node_Tree_Ref;
2557 To : Project_Node_Id)
2559 begin
2560 pragma Assert
2561 (Node /= Empty_Node
2562 and then
2563 (In_Tree.Project_Nodes.Table (Node).Kind =
2564 N_Variable_Reference
2565 or else
2566 In_Tree.Project_Nodes.Table (Node).Kind =
2567 N_Typed_Variable_Declaration)
2568 and then
2569 In_Tree.Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
2571 if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2572 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2573 else
2574 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2575 end if;
2576 end Set_String_Type_Of;
2578 -------------------------
2579 -- Set_String_Value_Of --
2580 -------------------------
2582 procedure Set_String_Value_Of
2583 (Node : Project_Node_Id;
2584 In_Tree : Project_Node_Tree_Ref;
2585 To : Name_Id)
2587 begin
2588 pragma Assert
2589 (Node /= Empty_Node
2590 and then
2591 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2592 or else
2593 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2594 or else
2595 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2596 In_Tree.Project_Nodes.Table (Node).Value := To;
2597 end Set_String_Value_Of;
2599 ---------------------
2600 -- Source_Index_Of --
2601 ---------------------
2603 function Source_Index_Of
2604 (Node : Project_Node_Id;
2605 In_Tree : Project_Node_Tree_Ref) return Int
2607 begin
2608 pragma Assert
2609 (Node /= Empty_Node
2610 and then
2611 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2612 or else
2613 In_Tree.Project_Nodes.Table (Node).Kind =
2614 N_Attribute_Declaration));
2615 return In_Tree.Project_Nodes.Table (Node).Src_Index;
2616 end Source_Index_Of;
2618 --------------------
2619 -- String_Type_Of --
2620 --------------------
2622 function String_Type_Of
2623 (Node : Project_Node_Id;
2624 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
2626 begin
2627 pragma Assert
2628 (Node /= Empty_Node
2629 and then
2630 (In_Tree.Project_Nodes.Table (Node).Kind =
2631 N_Variable_Reference
2632 or else
2633 In_Tree.Project_Nodes.Table (Node).Kind =
2634 N_Typed_Variable_Declaration));
2636 if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2637 return In_Tree.Project_Nodes.Table (Node).Field3;
2638 else
2639 return In_Tree.Project_Nodes.Table (Node).Field2;
2640 end if;
2641 end String_Type_Of;
2643 ---------------------
2644 -- String_Value_Of --
2645 ---------------------
2647 function String_Value_Of
2648 (Node : Project_Node_Id;
2649 In_Tree : Project_Node_Tree_Ref) return Name_Id
2651 begin
2652 pragma Assert
2653 (Node /= Empty_Node
2654 and then
2655 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2656 or else
2657 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2658 or else
2659 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2660 return In_Tree.Project_Nodes.Table (Node).Value;
2661 end String_Value_Of;
2663 --------------------
2664 -- Value_Is_Valid --
2665 --------------------
2667 function Value_Is_Valid
2668 (For_Typed_Variable : Project_Node_Id;
2669 In_Tree : Project_Node_Tree_Ref;
2670 Value : Name_Id) return Boolean
2672 begin
2673 pragma Assert
2674 (For_Typed_Variable /= Empty_Node
2675 and then
2676 (In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind =
2677 N_Typed_Variable_Declaration));
2679 declare
2680 Current_String : Project_Node_Id :=
2681 First_Literal_String
2682 (String_Type_Of (For_Typed_Variable, In_Tree),
2683 In_Tree);
2685 begin
2686 while Current_String /= Empty_Node
2687 and then
2688 String_Value_Of (Current_String, In_Tree) /= Value
2689 loop
2690 Current_String :=
2691 Next_Literal_String (Current_String, In_Tree);
2692 end loop;
2694 return Current_String /= Empty_Node;
2695 end;
2697 end Value_Is_Valid;
2699 -------------------------------
2700 -- There_Are_Unkept_Comments --
2701 -------------------------------
2703 function There_Are_Unkept_Comments return Boolean is
2704 begin
2705 return Unkept_Comments;
2706 end There_Are_Unkept_Comments;
2708 end Prj.Tree;