Merge from mainline
[official-gcc.git] / gcc / ada / prj-tree.adb
blob3bd65344022ece85eb8cbd7419acd4292f7c8782
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-2006, 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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, 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;
80 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
81 -- Returns the ID of the N_Comment_Zones node associated with node Node.
82 -- If there is not already an N_Comment_Zones node, create one and
83 -- associate it with node Node.
85 ------------------
86 -- Add_Comments --
87 ------------------
89 procedure Add_Comments
90 (To : Project_Node_Id;
91 In_Tree : Project_Node_Tree_Ref;
92 Where : Comment_Location) is
93 Zone : Project_Node_Id := Empty_Node;
94 Previous : Project_Node_Id := Empty_Node;
96 begin
97 pragma Assert
98 (To /= Empty_Node
99 and then
100 In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
102 Zone := In_Tree.Project_Nodes.Table (To).Comments;
104 if Zone = Empty_Node then
106 -- Create new N_Comment_Zones node
108 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
109 In_Tree.Project_Nodes.Table
110 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
111 (Kind => N_Comment_Zones,
112 Expr_Kind => Undefined,
113 Location => No_Location,
114 Directory => No_Name,
115 Variables => Empty_Node,
116 Packages => Empty_Node,
117 Pkg_Id => Empty_Package,
118 Name => No_Name,
119 Src_Index => 0,
120 Path_Name => No_Name,
121 Value => No_Name,
122 Field1 => Empty_Node,
123 Field2 => Empty_Node,
124 Field3 => Empty_Node,
125 Flag1 => False,
126 Flag2 => False,
127 Comments => Empty_Node);
129 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
130 In_Tree.Project_Nodes.Table (To).Comments := Zone;
131 end if;
133 if Where = End_Of_Line then
134 In_Tree.Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
136 else
137 -- Get each comments in the Comments table and link them to node To
139 for J in 1 .. Comments.Last loop
141 -- Create new N_Comment node
143 if (Where = After or else Where = After_End) and then
144 Token /= Tok_EOF and then
145 Comments.Table (J).Follows_Empty_Line
146 then
147 Comments.Table (1 .. Comments.Last - J + 1) :=
148 Comments.Table (J .. Comments.Last);
149 Comments.Set_Last (Comments.Last - J + 1);
150 return;
151 end if;
153 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
154 In_Tree.Project_Nodes.Table
155 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
156 (Kind => N_Comment,
157 Expr_Kind => Undefined,
158 Flag1 => Comments.Table (J).Follows_Empty_Line,
159 Flag2 =>
160 Comments.Table (J).Is_Followed_By_Empty_Line,
161 Location => No_Location,
162 Directory => No_Name,
163 Variables => Empty_Node,
164 Packages => Empty_Node,
165 Pkg_Id => Empty_Package,
166 Name => No_Name,
167 Src_Index => 0,
168 Path_Name => No_Name,
169 Value => Comments.Table (J).Value,
170 Field1 => Empty_Node,
171 Field2 => Empty_Node,
172 Field3 => Empty_Node,
173 Comments => Empty_Node);
175 -- If this is the first comment, put it in the right field of
176 -- the node Zone.
178 if Previous = Empty_Node then
179 case Where is
180 when Before =>
181 In_Tree.Project_Nodes.Table (Zone).Field1 :=
182 Project_Node_Table.Last (In_Tree.Project_Nodes);
184 when After =>
185 In_Tree.Project_Nodes.Table (Zone).Field2 :=
186 Project_Node_Table.Last (In_Tree.Project_Nodes);
188 when Before_End =>
189 In_Tree.Project_Nodes.Table (Zone).Field3 :=
190 Project_Node_Table.Last (In_Tree.Project_Nodes);
192 when After_End =>
193 In_Tree.Project_Nodes.Table (Zone).Comments :=
194 Project_Node_Table.Last (In_Tree.Project_Nodes);
196 when End_Of_Line =>
197 null;
198 end case;
200 else
201 -- When it is not the first, link it to the previous one
203 In_Tree.Project_Nodes.Table (Previous).Comments :=
204 Project_Node_Table.Last (In_Tree.Project_Nodes);
205 end if;
207 -- This node becomes the previous one for the next comment, if
208 -- there is one.
210 Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
211 end loop;
212 end if;
214 -- Empty the Comments table, so that there is no risk to link the same
215 -- comments to another node.
217 Comments.Set_Last (0);
218 end Add_Comments;
220 --------------------------------
221 -- Associative_Array_Index_Of --
222 --------------------------------
224 function Associative_Array_Index_Of
225 (Node : Project_Node_Id;
226 In_Tree : Project_Node_Tree_Ref) return Name_Id
228 begin
229 pragma Assert
230 (Node /= Empty_Node
231 and then
232 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
233 or else
234 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
235 return In_Tree.Project_Nodes.Table (Node).Value;
236 end Associative_Array_Index_Of;
238 ----------------------------
239 -- Associative_Package_Of --
240 ----------------------------
242 function Associative_Package_Of
243 (Node : Project_Node_Id;
244 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
246 begin
247 pragma Assert
248 (Node /= Empty_Node
249 and then
250 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
251 return In_Tree.Project_Nodes.Table (Node).Field3;
252 end Associative_Package_Of;
254 ----------------------------
255 -- Associative_Project_Of --
256 ----------------------------
258 function Associative_Project_Of
259 (Node : Project_Node_Id;
260 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
262 begin
263 pragma Assert
264 (Node /= Empty_Node
265 and then
266 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
267 return In_Tree.Project_Nodes.Table (Node).Field2;
268 end Associative_Project_Of;
270 ----------------------
271 -- Case_Insensitive --
272 ----------------------
274 function Case_Insensitive
275 (Node : Project_Node_Id;
276 In_Tree : Project_Node_Tree_Ref) return Boolean is
277 begin
278 pragma Assert
279 (Node /= Empty_Node
280 and then
281 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
282 or else
283 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
284 return In_Tree.Project_Nodes.Table (Node).Flag1;
285 end Case_Insensitive;
287 --------------------------------
288 -- Case_Variable_Reference_Of --
289 --------------------------------
291 function Case_Variable_Reference_Of
292 (Node : Project_Node_Id;
293 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
295 begin
296 pragma Assert
297 (Node /= Empty_Node
298 and then
299 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
300 return In_Tree.Project_Nodes.Table (Node).Field1;
301 end Case_Variable_Reference_Of;
303 ----------------------
304 -- Comment_Zones_Of --
305 ----------------------
307 function Comment_Zones_Of
308 (Node : Project_Node_Id;
309 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
311 Zone : Project_Node_Id;
313 begin
314 pragma Assert (Node /= Empty_Node);
315 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
317 -- If there is not already an N_Comment_Zones associated, create a new
318 -- one and associate it with node Node.
320 if Zone = Empty_Node then
321 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
322 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
323 In_Tree.Project_Nodes.Table (Zone) :=
324 (Kind => N_Comment_Zones,
325 Location => No_Location,
326 Directory => No_Name,
327 Expr_Kind => Undefined,
328 Variables => Empty_Node,
329 Packages => Empty_Node,
330 Pkg_Id => Empty_Package,
331 Name => No_Name,
332 Src_Index => 0,
333 Path_Name => No_Name,
334 Value => No_Name,
335 Field1 => Empty_Node,
336 Field2 => Empty_Node,
337 Field3 => Empty_Node,
338 Flag1 => False,
339 Flag2 => False,
340 Comments => Empty_Node);
341 In_Tree.Project_Nodes.Table (Node).Comments := Zone;
342 end if;
344 return Zone;
345 end Comment_Zones_Of;
347 -----------------------
348 -- Current_Item_Node --
349 -----------------------
351 function Current_Item_Node
352 (Node : Project_Node_Id;
353 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
355 begin
356 pragma Assert
357 (Node /= Empty_Node
358 and then
359 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
360 return In_Tree.Project_Nodes.Table (Node).Field1;
361 end Current_Item_Node;
363 ------------------
364 -- Current_Term --
365 ------------------
367 function Current_Term
368 (Node : Project_Node_Id;
369 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
371 begin
372 pragma Assert
373 (Node /= Empty_Node
374 and then
375 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
376 return In_Tree.Project_Nodes.Table (Node).Field1;
377 end Current_Term;
379 --------------------------
380 -- Default_Project_Node --
381 --------------------------
383 function Default_Project_Node
384 (In_Tree : Project_Node_Tree_Ref;
385 Of_Kind : Project_Node_Kind;
386 And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id
388 Result : Project_Node_Id;
389 Zone : Project_Node_Id;
390 Previous : Project_Node_Id;
392 begin
393 -- Create new node with specified kind and expression kind
395 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
396 In_Tree.Project_Nodes.Table
397 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
398 (Kind => Of_Kind,
399 Location => No_Location,
400 Directory => No_Name,
401 Expr_Kind => And_Expr_Kind,
402 Variables => Empty_Node,
403 Packages => Empty_Node,
404 Pkg_Id => Empty_Package,
405 Name => No_Name,
406 Src_Index => 0,
407 Path_Name => No_Name,
408 Value => No_Name,
409 Field1 => Empty_Node,
410 Field2 => Empty_Node,
411 Field3 => Empty_Node,
412 Flag1 => False,
413 Flag2 => False,
414 Comments => Empty_Node);
416 -- Save the new node for the returned value
418 Result := Project_Node_Table.Last (In_Tree.Project_Nodes);
420 if Comments.Last > 0 then
422 -- If this is not a node with comments, then set the flag
424 if not Node_With_Comments (Of_Kind) then
425 Unkept_Comments := True;
427 elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then
429 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
430 In_Tree.Project_Nodes.Table
431 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
432 (Kind => N_Comment_Zones,
433 Expr_Kind => Undefined,
434 Location => No_Location,
435 Directory => No_Name,
436 Variables => Empty_Node,
437 Packages => Empty_Node,
438 Pkg_Id => Empty_Package,
439 Name => No_Name,
440 Src_Index => 0,
441 Path_Name => No_Name,
442 Value => No_Name,
443 Field1 => Empty_Node,
444 Field2 => Empty_Node,
445 Field3 => Empty_Node,
446 Flag1 => False,
447 Flag2 => False,
448 Comments => Empty_Node);
450 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
451 In_Tree.Project_Nodes.Table (Result).Comments := Zone;
452 Previous := Empty_Node;
454 for J in 1 .. Comments.Last loop
456 -- Create a new N_Comment node
458 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
459 In_Tree.Project_Nodes.Table
460 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
461 (Kind => N_Comment,
462 Expr_Kind => Undefined,
463 Flag1 => Comments.Table (J).Follows_Empty_Line,
464 Flag2 =>
465 Comments.Table (J).Is_Followed_By_Empty_Line,
466 Location => No_Location,
467 Directory => No_Name,
468 Variables => Empty_Node,
469 Packages => Empty_Node,
470 Pkg_Id => Empty_Package,
471 Name => No_Name,
472 Src_Index => 0,
473 Path_Name => No_Name,
474 Value => Comments.Table (J).Value,
475 Field1 => Empty_Node,
476 Field2 => Empty_Node,
477 Field3 => Empty_Node,
478 Comments => Empty_Node);
480 -- Link it to the N_Comment_Zones node, if it is the first,
481 -- otherwise to the previous one.
483 if Previous = Empty_Node then
484 In_Tree.Project_Nodes.Table (Zone).Field1 :=
485 Project_Node_Table.Last (In_Tree.Project_Nodes);
487 else
488 In_Tree.Project_Nodes.Table (Previous).Comments :=
489 Project_Node_Table.Last (In_Tree.Project_Nodes);
490 end if;
492 -- This new node will be the previous one for the next
493 -- N_Comment node, if there is one.
495 Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
496 end loop;
498 -- Empty the Comments table after all comments have been processed
500 Comments.Set_Last (0);
501 end if;
502 end if;
504 return Result;
505 end Default_Project_Node;
507 ------------------
508 -- Directory_Of --
509 ------------------
511 function Directory_Of
512 (Node : Project_Node_Id;
513 In_Tree : Project_Node_Tree_Ref) return Name_Id is
514 begin
515 pragma Assert
516 (Node /= Empty_Node
517 and then
518 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
519 return In_Tree.Project_Nodes.Table (Node).Directory;
520 end Directory_Of;
522 -------------------------
523 -- End_Of_Line_Comment --
524 -------------------------
526 function End_Of_Line_Comment
527 (Node : Project_Node_Id;
528 In_Tree : Project_Node_Tree_Ref) return Name_Id is
529 Zone : Project_Node_Id := Empty_Node;
531 begin
532 pragma Assert (Node /= Empty_Node);
533 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
535 if Zone = Empty_Node then
536 return No_Name;
537 else
538 return In_Tree.Project_Nodes.Table (Zone).Value;
539 end if;
540 end End_Of_Line_Comment;
542 ------------------------
543 -- Expression_Kind_Of --
544 ------------------------
546 function Expression_Kind_Of
547 (Node : Project_Node_Id;
548 In_Tree : Project_Node_Tree_Ref) return Variable_Kind is
549 begin
550 pragma Assert
551 (Node /= Empty_Node
552 and then
553 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
554 or else
555 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
556 or else
557 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
558 or else
559 In_Tree.Project_Nodes.Table (Node).Kind =
560 N_Typed_Variable_Declaration
561 or else
562 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
563 or else
564 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
565 or else
566 In_Tree.Project_Nodes.Table (Node).Kind = N_Term
567 or else
568 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
569 or else
570 In_Tree.Project_Nodes.Table (Node).Kind =
571 N_Attribute_Reference));
573 return In_Tree.Project_Nodes.Table (Node).Expr_Kind;
574 end Expression_Kind_Of;
576 -------------------
577 -- Expression_Of --
578 -------------------
580 function Expression_Of
581 (Node : Project_Node_Id;
582 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
584 begin
585 pragma Assert
586 (Node /= Empty_Node
587 and then
588 (In_Tree.Project_Nodes.Table (Node).Kind =
589 N_Attribute_Declaration
590 or else
591 In_Tree.Project_Nodes.Table (Node).Kind =
592 N_Typed_Variable_Declaration
593 or else
594 In_Tree.Project_Nodes.Table (Node).Kind =
595 N_Variable_Declaration));
597 return In_Tree.Project_Nodes.Table (Node).Field1;
598 end Expression_Of;
600 -------------------------
601 -- Extended_Project_Of --
602 -------------------------
604 function Extended_Project_Of
605 (Node : Project_Node_Id;
606 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
608 begin
609 pragma Assert
610 (Node /= Empty_Node
611 and then
612 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
613 return In_Tree.Project_Nodes.Table (Node).Field2;
614 end Extended_Project_Of;
616 ------------------------------
617 -- Extended_Project_Path_Of --
618 ------------------------------
620 function Extended_Project_Path_Of
621 (Node : Project_Node_Id;
622 In_Tree : Project_Node_Tree_Ref) return Name_Id
624 begin
625 pragma Assert
626 (Node /= Empty_Node
627 and then
628 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
629 return In_Tree.Project_Nodes.Table (Node).Value;
630 end Extended_Project_Path_Of;
632 --------------------------
633 -- Extending_Project_Of --
634 --------------------------
635 function Extending_Project_Of
636 (Node : Project_Node_Id;
637 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
639 begin
640 pragma Assert
641 (Node /= Empty_Node
642 and then
643 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
644 return In_Tree.Project_Nodes.Table (Node).Field3;
645 end Extending_Project_Of;
647 ---------------------------
648 -- External_Reference_Of --
649 ---------------------------
651 function External_Reference_Of
652 (Node : Project_Node_Id;
653 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
655 begin
656 pragma Assert
657 (Node /= Empty_Node
658 and then
659 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
660 return In_Tree.Project_Nodes.Table (Node).Field1;
661 end External_Reference_Of;
663 -------------------------
664 -- External_Default_Of --
665 -------------------------
667 function External_Default_Of
668 (Node : Project_Node_Id;
669 In_Tree : Project_Node_Tree_Ref)
670 return Project_Node_Id
672 begin
673 pragma Assert
674 (Node /= Empty_Node
675 and then
676 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
677 return In_Tree.Project_Nodes.Table (Node).Field2;
678 end External_Default_Of;
680 ------------------------
681 -- First_Case_Item_Of --
682 ------------------------
684 function First_Case_Item_Of
685 (Node : Project_Node_Id;
686 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
688 begin
689 pragma Assert
690 (Node /= Empty_Node
691 and then
692 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
693 return In_Tree.Project_Nodes.Table (Node).Field2;
694 end First_Case_Item_Of;
696 ---------------------
697 -- First_Choice_Of --
698 ---------------------
700 function First_Choice_Of
701 (Node : Project_Node_Id;
702 In_Tree : Project_Node_Tree_Ref)
703 return Project_Node_Id
705 begin
706 pragma Assert
707 (Node /= Empty_Node
708 and then
709 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
710 return In_Tree.Project_Nodes.Table (Node).Field1;
711 end First_Choice_Of;
713 -------------------------
714 -- First_Comment_After --
715 -------------------------
717 function First_Comment_After
718 (Node : Project_Node_Id;
719 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
721 Zone : Project_Node_Id := Empty_Node;
722 begin
723 pragma Assert (Node /= Empty_Node);
724 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
726 if Zone = Empty_Node then
727 return Empty_Node;
729 else
730 return In_Tree.Project_Nodes.Table (Zone).Field2;
731 end if;
732 end First_Comment_After;
734 -----------------------------
735 -- First_Comment_After_End --
736 -----------------------------
738 function First_Comment_After_End
739 (Node : Project_Node_Id;
740 In_Tree : Project_Node_Tree_Ref)
741 return Project_Node_Id
743 Zone : Project_Node_Id := Empty_Node;
745 begin
746 pragma Assert (Node /= Empty_Node);
747 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
749 if Zone = Empty_Node then
750 return Empty_Node;
752 else
753 return In_Tree.Project_Nodes.Table (Zone).Comments;
754 end if;
755 end First_Comment_After_End;
757 --------------------------
758 -- First_Comment_Before --
759 --------------------------
761 function First_Comment_Before
762 (Node : Project_Node_Id;
763 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
765 Zone : Project_Node_Id := Empty_Node;
767 begin
768 pragma Assert (Node /= Empty_Node);
769 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
771 if Zone = Empty_Node then
772 return Empty_Node;
774 else
775 return In_Tree.Project_Nodes.Table (Zone).Field1;
776 end if;
777 end First_Comment_Before;
779 ------------------------------
780 -- First_Comment_Before_End --
781 ------------------------------
783 function First_Comment_Before_End
784 (Node : Project_Node_Id;
785 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
787 Zone : Project_Node_Id := Empty_Node;
789 begin
790 pragma Assert (Node /= Empty_Node);
791 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
793 if Zone = Empty_Node then
794 return Empty_Node;
796 else
797 return In_Tree.Project_Nodes.Table (Zone).Field3;
798 end if;
799 end First_Comment_Before_End;
801 -------------------------------
802 -- First_Declarative_Item_Of --
803 -------------------------------
805 function First_Declarative_Item_Of
806 (Node : Project_Node_Id;
807 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
809 begin
810 pragma Assert
811 (Node /= Empty_Node
812 and then
813 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
814 or else
815 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
816 or else
817 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
819 if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
820 return In_Tree.Project_Nodes.Table (Node).Field1;
821 else
822 return In_Tree.Project_Nodes.Table (Node).Field2;
823 end if;
824 end First_Declarative_Item_Of;
826 ------------------------------
827 -- First_Expression_In_List --
828 ------------------------------
830 function First_Expression_In_List
831 (Node : Project_Node_Id;
832 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
834 begin
835 pragma Assert
836 (Node /= Empty_Node
837 and then
838 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
839 return In_Tree.Project_Nodes.Table (Node).Field1;
840 end First_Expression_In_List;
842 --------------------------
843 -- First_Literal_String --
844 --------------------------
846 function First_Literal_String
847 (Node : Project_Node_Id;
848 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
850 begin
851 pragma Assert
852 (Node /= Empty_Node
853 and then
854 In_Tree.Project_Nodes.Table (Node).Kind =
855 N_String_Type_Declaration);
856 return In_Tree.Project_Nodes.Table (Node).Field1;
857 end First_Literal_String;
859 ----------------------
860 -- First_Package_Of --
861 ----------------------
863 function First_Package_Of
864 (Node : Project_Node_Id;
865 In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id
867 begin
868 pragma Assert
869 (Node /= Empty_Node
870 and then
871 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
872 return In_Tree.Project_Nodes.Table (Node).Packages;
873 end First_Package_Of;
875 --------------------------
876 -- First_String_Type_Of --
877 --------------------------
879 function First_String_Type_Of
880 (Node : Project_Node_Id;
881 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
883 begin
884 pragma Assert
885 (Node /= Empty_Node
886 and then
887 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
888 return In_Tree.Project_Nodes.Table (Node).Field3;
889 end First_String_Type_Of;
891 ----------------
892 -- First_Term --
893 ----------------
895 function First_Term
896 (Node : Project_Node_Id;
897 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
899 begin
900 pragma Assert
901 (Node /= Empty_Node
902 and then
903 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
904 return In_Tree.Project_Nodes.Table (Node).Field1;
905 end First_Term;
907 -----------------------
908 -- First_Variable_Of --
909 -----------------------
911 function First_Variable_Of
912 (Node : Project_Node_Id;
913 In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id
915 begin
916 pragma Assert
917 (Node /= Empty_Node
918 and then
919 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
920 or else
921 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
923 return In_Tree.Project_Nodes.Table (Node).Variables;
924 end First_Variable_Of;
926 --------------------------
927 -- First_With_Clause_Of --
928 --------------------------
930 function First_With_Clause_Of
931 (Node : Project_Node_Id;
932 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
934 begin
935 pragma Assert
936 (Node /= Empty_Node
937 and then
938 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
939 return In_Tree.Project_Nodes.Table (Node).Field1;
940 end First_With_Clause_Of;
942 ------------------------
943 -- Follows_Empty_Line --
944 ------------------------
946 function Follows_Empty_Line
947 (Node : Project_Node_Id;
948 In_Tree : Project_Node_Tree_Ref) return Boolean is
949 begin
950 pragma Assert
951 (Node /= Empty_Node
952 and then
953 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
954 return In_Tree.Project_Nodes.Table (Node).Flag1;
955 end Follows_Empty_Line;
957 ----------
958 -- Hash --
959 ----------
961 function Hash (N : Project_Node_Id) return Header_Num is
962 begin
963 return Header_Num (N mod Project_Node_Id (Header_Num'Last));
964 end Hash;
966 ----------------
967 -- Initialize --
968 ----------------
970 procedure Initialize (Tree : Project_Node_Tree_Ref) is
971 begin
972 Project_Node_Table.Init (Tree.Project_Nodes);
973 Projects_Htable.Reset (Tree.Projects_HT);
974 end Initialize;
976 -------------------------------
977 -- Is_Followed_By_Empty_Line --
978 -------------------------------
980 function Is_Followed_By_Empty_Line
981 (Node : Project_Node_Id;
982 In_Tree : Project_Node_Tree_Ref) return Boolean
984 begin
985 pragma Assert
986 (Node /= Empty_Node
987 and then
988 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
989 return In_Tree.Project_Nodes.Table (Node).Flag2;
990 end Is_Followed_By_Empty_Line;
992 ----------------------
993 -- Is_Extending_All --
994 ----------------------
996 function Is_Extending_All
997 (Node : Project_Node_Id;
998 In_Tree : Project_Node_Tree_Ref) return Boolean is
999 begin
1000 pragma Assert
1001 (Node /= Empty_Node
1002 and then
1003 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1004 or else
1005 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1006 return In_Tree.Project_Nodes.Table (Node).Flag2;
1007 end Is_Extending_All;
1009 -------------------------
1010 -- Is_Not_Last_In_List --
1011 -------------------------
1013 function Is_Not_Last_In_List
1014 (Node : Project_Node_Id;
1015 In_Tree : Project_Node_Tree_Ref) return Boolean is
1016 begin
1017 pragma Assert
1018 (Node /= Empty_Node
1019 and then
1020 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1021 return In_Tree.Project_Nodes.Table (Node).Flag1;
1022 end Is_Not_Last_In_List;
1024 -------------------------------------
1025 -- Imported_Or_Extended_Project_Of --
1026 -------------------------------------
1028 function Imported_Or_Extended_Project_Of
1029 (Project : Project_Node_Id;
1030 In_Tree : Project_Node_Tree_Ref;
1031 With_Name : Name_Id) return Project_Node_Id
1033 With_Clause : Project_Node_Id :=
1034 First_With_Clause_Of (Project, In_Tree);
1035 Result : Project_Node_Id := Empty_Node;
1037 begin
1038 -- First check all the imported projects
1040 while With_Clause /= Empty_Node loop
1042 -- Only non limited imported project may be used as prefix
1043 -- of variable or attributes.
1045 Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree);
1046 exit when Result /= Empty_Node
1047 and then Name_Of (Result, In_Tree) = With_Name;
1048 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1049 end loop;
1051 -- If it is not an imported project, it might be the imported project
1053 if With_Clause = Empty_Node then
1054 Result :=
1055 Extended_Project_Of
1056 (Project_Declaration_Of (Project, In_Tree), In_Tree);
1058 if Result /= Empty_Node
1059 and then Name_Of (Result, In_Tree) /= With_Name
1060 then
1061 Result := Empty_Node;
1062 end if;
1063 end if;
1065 return Result;
1066 end Imported_Or_Extended_Project_Of;
1068 -------------
1069 -- Kind_Of --
1070 -------------
1072 function Kind_Of
1073 (Node : Project_Node_Id;
1074 In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind is
1075 begin
1076 pragma Assert (Node /= Empty_Node);
1077 return In_Tree.Project_Nodes.Table (Node).Kind;
1078 end Kind_Of;
1080 -----------------
1081 -- Location_Of --
1082 -----------------
1084 function Location_Of
1085 (Node : Project_Node_Id;
1086 In_Tree : Project_Node_Tree_Ref) return Source_Ptr is
1087 begin
1088 pragma Assert (Node /= Empty_Node);
1089 return In_Tree.Project_Nodes.Table (Node).Location;
1090 end Location_Of;
1092 -------------
1093 -- Name_Of --
1094 -------------
1096 function Name_Of
1097 (Node : Project_Node_Id;
1098 In_Tree : Project_Node_Tree_Ref) return Name_Id is
1099 begin
1100 pragma Assert (Node /= Empty_Node);
1101 return In_Tree.Project_Nodes.Table (Node).Name;
1102 end Name_Of;
1104 --------------------
1105 -- Next_Case_Item --
1106 --------------------
1108 function Next_Case_Item
1109 (Node : Project_Node_Id;
1110 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1112 begin
1113 pragma Assert
1114 (Node /= Empty_Node
1115 and then
1116 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1117 return In_Tree.Project_Nodes.Table (Node).Field3;
1118 end Next_Case_Item;
1120 ------------------
1121 -- Next_Comment --
1122 ------------------
1124 function Next_Comment
1125 (Node : Project_Node_Id;
1126 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is
1127 begin
1128 pragma Assert
1129 (Node /= Empty_Node
1130 and then
1131 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1132 return In_Tree.Project_Nodes.Table (Node).Comments;
1133 end Next_Comment;
1135 ---------------------------
1136 -- Next_Declarative_Item --
1137 ---------------------------
1139 function Next_Declarative_Item
1140 (Node : Project_Node_Id;
1141 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1143 begin
1144 pragma Assert
1145 (Node /= Empty_Node
1146 and then
1147 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1148 return In_Tree.Project_Nodes.Table (Node).Field2;
1149 end Next_Declarative_Item;
1151 -----------------------------
1152 -- Next_Expression_In_List --
1153 -----------------------------
1155 function Next_Expression_In_List
1156 (Node : Project_Node_Id;
1157 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1159 begin
1160 pragma Assert
1161 (Node /= Empty_Node
1162 and then
1163 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
1164 return In_Tree.Project_Nodes.Table (Node).Field2;
1165 end Next_Expression_In_List;
1167 -------------------------
1168 -- Next_Literal_String --
1169 -------------------------
1171 function Next_Literal_String
1172 (Node : Project_Node_Id;
1173 In_Tree : Project_Node_Tree_Ref)
1174 return Project_Node_Id
1176 begin
1177 pragma Assert
1178 (Node /= Empty_Node
1179 and then
1180 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
1181 return In_Tree.Project_Nodes.Table (Node).Field1;
1182 end Next_Literal_String;
1184 -----------------------------
1185 -- Next_Package_In_Project --
1186 -----------------------------
1188 function Next_Package_In_Project
1189 (Node : Project_Node_Id;
1190 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1192 begin
1193 pragma Assert
1194 (Node /= Empty_Node
1195 and then
1196 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1197 return In_Tree.Project_Nodes.Table (Node).Field3;
1198 end Next_Package_In_Project;
1200 ----------------------
1201 -- Next_String_Type --
1202 ----------------------
1204 function Next_String_Type
1205 (Node : Project_Node_Id;
1206 In_Tree : Project_Node_Tree_Ref)
1207 return Project_Node_Id
1209 begin
1210 pragma Assert
1211 (Node /= Empty_Node
1212 and then
1213 In_Tree.Project_Nodes.Table (Node).Kind =
1214 N_String_Type_Declaration);
1215 return In_Tree.Project_Nodes.Table (Node).Field2;
1216 end Next_String_Type;
1218 ---------------
1219 -- Next_Term --
1220 ---------------
1222 function Next_Term
1223 (Node : Project_Node_Id;
1224 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1226 begin
1227 pragma Assert
1228 (Node /= Empty_Node
1229 and then
1230 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1231 return In_Tree.Project_Nodes.Table (Node).Field2;
1232 end Next_Term;
1234 -------------------
1235 -- Next_Variable --
1236 -------------------
1238 function Next_Variable
1239 (Node : Project_Node_Id;
1240 In_Tree : Project_Node_Tree_Ref)
1241 return Project_Node_Id
1243 begin
1244 pragma Assert
1245 (Node /= Empty_Node
1246 and then
1247 (In_Tree.Project_Nodes.Table (Node).Kind =
1248 N_Typed_Variable_Declaration
1249 or else
1250 In_Tree.Project_Nodes.Table (Node).Kind =
1251 N_Variable_Declaration));
1253 return In_Tree.Project_Nodes.Table (Node).Field3;
1254 end Next_Variable;
1256 -------------------------
1257 -- Next_With_Clause_Of --
1258 -------------------------
1260 function Next_With_Clause_Of
1261 (Node : Project_Node_Id;
1262 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1264 begin
1265 pragma Assert
1266 (Node /= Empty_Node
1267 and then
1268 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1269 return In_Tree.Project_Nodes.Table (Node).Field2;
1270 end Next_With_Clause_Of;
1272 ---------------------------------
1273 -- Non_Limited_Project_Node_Of --
1274 ---------------------------------
1276 function Non_Limited_Project_Node_Of
1277 (Node : Project_Node_Id;
1278 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1280 begin
1281 pragma Assert
1282 (Node /= Empty_Node
1283 and then
1284 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1285 return In_Tree.Project_Nodes.Table (Node).Field3;
1286 end Non_Limited_Project_Node_Of;
1288 -------------------
1289 -- Package_Id_Of --
1290 -------------------
1292 function Package_Id_Of
1293 (Node : Project_Node_Id;
1294 In_Tree : Project_Node_Tree_Ref) return Package_Node_Id
1296 begin
1297 pragma Assert
1298 (Node /= Empty_Node
1299 and then
1300 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1301 return In_Tree.Project_Nodes.Table (Node).Pkg_Id;
1302 end Package_Id_Of;
1304 ---------------------
1305 -- Package_Node_Of --
1306 ---------------------
1308 function Package_Node_Of
1309 (Node : Project_Node_Id;
1310 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1312 begin
1313 pragma Assert
1314 (Node /= Empty_Node
1315 and then
1316 (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1317 or else
1318 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1319 return In_Tree.Project_Nodes.Table (Node).Field2;
1320 end Package_Node_Of;
1322 ------------------
1323 -- Path_Name_Of --
1324 ------------------
1326 function Path_Name_Of
1327 (Node : Project_Node_Id;
1328 In_Tree : Project_Node_Tree_Ref) return Name_Id
1330 begin
1331 pragma Assert
1332 (Node /= Empty_Node
1333 and then
1334 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1335 or else
1336 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1337 return In_Tree.Project_Nodes.Table (Node).Path_Name;
1338 end Path_Name_Of;
1340 ----------------------------
1341 -- Project_Declaration_Of --
1342 ----------------------------
1344 function Project_Declaration_Of
1345 (Node : Project_Node_Id;
1346 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1348 begin
1349 pragma Assert
1350 (Node /= Empty_Node
1351 and then
1352 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1353 return In_Tree.Project_Nodes.Table (Node).Field2;
1354 end Project_Declaration_Of;
1356 -------------------------------------------
1357 -- Project_File_Includes_Unkept_Comments --
1358 -------------------------------------------
1360 function Project_File_Includes_Unkept_Comments
1361 (Node : Project_Node_Id;
1362 In_Tree : Project_Node_Tree_Ref) return Boolean
1364 Declaration : constant Project_Node_Id :=
1365 Project_Declaration_Of (Node, In_Tree);
1366 begin
1367 return In_Tree.Project_Nodes.Table (Declaration).Flag1;
1368 end Project_File_Includes_Unkept_Comments;
1370 ---------------------
1371 -- Project_Node_Of --
1372 ---------------------
1374 function Project_Node_Of
1375 (Node : Project_Node_Id;
1376 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1378 begin
1379 pragma Assert
1380 (Node /= Empty_Node
1381 and then
1382 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
1383 or else
1384 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1385 or else
1386 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1387 return In_Tree.Project_Nodes.Table (Node).Field1;
1388 end Project_Node_Of;
1390 -----------------------------------
1391 -- Project_Of_Renamed_Package_Of --
1392 -----------------------------------
1394 function Project_Of_Renamed_Package_Of
1395 (Node : Project_Node_Id;
1396 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1398 begin
1399 pragma Assert
1400 (Node /= Empty_Node
1401 and then
1402 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1403 return In_Tree.Project_Nodes.Table (Node).Field1;
1404 end Project_Of_Renamed_Package_Of;
1406 --------------------------
1407 -- Remove_Next_End_Node --
1408 --------------------------
1410 procedure Remove_Next_End_Node is
1411 begin
1412 Next_End_Nodes.Decrement_Last;
1413 end Remove_Next_End_Node;
1415 -----------------
1416 -- Reset_State --
1417 -----------------
1419 procedure Reset_State is
1420 begin
1421 End_Of_Line_Node := Empty_Node;
1422 Previous_Line_Node := Empty_Node;
1423 Previous_End_Node := Empty_Node;
1424 Unkept_Comments := False;
1425 Comments.Set_Last (0);
1426 end Reset_State;
1428 -------------
1429 -- Restore --
1430 -------------
1432 procedure Restore (S : Comment_State) is
1433 begin
1434 End_Of_Line_Node := S.End_Of_Line_Node;
1435 Previous_Line_Node := S.Previous_Line_Node;
1436 Previous_End_Node := S.Previous_End_Node;
1437 Next_End_Nodes.Set_Last (0);
1438 Unkept_Comments := S.Unkept_Comments;
1440 Comments.Set_Last (0);
1442 for J in S.Comments'Range loop
1443 Comments.Increment_Last;
1444 Comments.Table (Comments.Last) := S.Comments (J);
1445 end loop;
1446 end Restore;
1448 ----------
1449 -- Save --
1450 ----------
1452 procedure Save (S : out Comment_State) is
1453 Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last);
1455 begin
1456 for J in 1 .. Comments.Last loop
1457 Cmts (J) := Comments.Table (J);
1458 end loop;
1460 S :=
1461 (End_Of_Line_Node => End_Of_Line_Node,
1462 Previous_Line_Node => Previous_Line_Node,
1463 Previous_End_Node => Previous_End_Node,
1464 Unkept_Comments => Unkept_Comments,
1465 Comments => Cmts);
1466 end Save;
1468 ----------
1469 -- Scan --
1470 ----------
1472 procedure Scan (In_Tree : Project_Node_Tree_Ref) is
1473 Empty_Line : Boolean := False;
1475 begin
1476 -- If there are comments, then they will not be kept. Set the flag and
1477 -- clear the comments.
1479 if Comments.Last > 0 then
1480 Unkept_Comments := True;
1481 Comments.Set_Last (0);
1482 end if;
1484 -- Loop until a token other that End_Of_Line or Comment is found
1486 loop
1487 Prj.Err.Scanner.Scan;
1489 case Token is
1490 when Tok_End_Of_Line =>
1491 if Prev_Token = Tok_End_Of_Line then
1492 Empty_Line := True;
1494 if Comments.Last > 0 then
1495 Comments.Table (Comments.Last).Is_Followed_By_Empty_Line
1496 := True;
1497 end if;
1498 end if;
1500 when Tok_Comment =>
1501 -- If this is a line comment, add it to the comment table
1503 if Prev_Token = Tok_End_Of_Line
1504 or else Prev_Token = No_Token
1505 then
1506 Comments.Increment_Last;
1507 Comments.Table (Comments.Last) :=
1508 (Value => Comment_Id,
1509 Follows_Empty_Line => Empty_Line,
1510 Is_Followed_By_Empty_Line => False);
1512 -- Otherwise, it is an end of line comment. If there is
1513 -- an end of line node specified, associate the comment with
1514 -- this node.
1516 elsif End_Of_Line_Node /= Empty_Node then
1517 declare
1518 Zones : constant Project_Node_Id :=
1519 Comment_Zones_Of (End_Of_Line_Node, In_Tree);
1520 begin
1521 In_Tree.Project_Nodes.Table (Zones).Value := Comment_Id;
1522 end;
1524 -- Otherwise, this end of line node cannot be kept
1526 else
1527 Unkept_Comments := True;
1528 Comments.Set_Last (0);
1529 end if;
1531 Empty_Line := False;
1533 when others =>
1534 -- If there are comments, where the first comment is not
1535 -- following an empty line, put the initial uninterrupted
1536 -- comment zone with the node of the preceding line (either
1537 -- a Previous_Line or a Previous_End node), if any.
1539 if Comments.Last > 0 and then
1540 not Comments.Table (1).Follows_Empty_Line then
1541 if Previous_Line_Node /= Empty_Node then
1542 Add_Comments
1543 (To => Previous_Line_Node,
1544 Where => After,
1545 In_Tree => In_Tree);
1547 elsif Previous_End_Node /= Empty_Node then
1548 Add_Comments
1549 (To => Previous_End_Node,
1550 Where => After_End,
1551 In_Tree => In_Tree);
1552 end if;
1553 end if;
1555 -- If there are still comments and the token is "end", then
1556 -- put these comments with the Next_End node, if any;
1557 -- otherwise, these comments cannot be kept. Always clear
1558 -- the comments.
1560 if Comments.Last > 0 and then Token = Tok_End then
1561 if Next_End_Nodes.Last > 0 then
1562 Add_Comments
1563 (To => Next_End_Nodes.Table (Next_End_Nodes.Last),
1564 Where => Before_End,
1565 In_Tree => In_Tree);
1567 else
1568 Unkept_Comments := True;
1569 end if;
1571 Comments.Set_Last (0);
1572 end if;
1574 -- Reset the End_Of_Line, Previous_Line and Previous_End nodes
1575 -- so that they are not used again.
1577 End_Of_Line_Node := Empty_Node;
1578 Previous_Line_Node := Empty_Node;
1579 Previous_End_Node := Empty_Node;
1581 -- And return
1583 exit;
1584 end case;
1585 end loop;
1586 end Scan;
1588 ------------------------------------
1589 -- Set_Associative_Array_Index_Of --
1590 ------------------------------------
1592 procedure Set_Associative_Array_Index_Of
1593 (Node : Project_Node_Id;
1594 In_Tree : Project_Node_Tree_Ref;
1595 To : Name_Id)
1597 begin
1598 pragma Assert
1599 (Node /= Empty_Node
1600 and then
1601 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1602 or else
1603 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1604 In_Tree.Project_Nodes.Table (Node).Value := To;
1605 end Set_Associative_Array_Index_Of;
1607 --------------------------------
1608 -- Set_Associative_Package_Of --
1609 --------------------------------
1611 procedure Set_Associative_Package_Of
1612 (Node : Project_Node_Id;
1613 In_Tree : Project_Node_Tree_Ref;
1614 To : Project_Node_Id)
1616 begin
1617 pragma Assert
1618 (Node /= Empty_Node
1619 and then
1620 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
1621 In_Tree.Project_Nodes.Table (Node).Field3 := To;
1622 end Set_Associative_Package_Of;
1624 --------------------------------
1625 -- Set_Associative_Project_Of --
1626 --------------------------------
1628 procedure Set_Associative_Project_Of
1629 (Node : Project_Node_Id;
1630 In_Tree : Project_Node_Tree_Ref;
1631 To : Project_Node_Id)
1633 begin
1634 pragma Assert
1635 (Node /= Empty_Node
1636 and then
1637 (In_Tree.Project_Nodes.Table (Node).Kind =
1638 N_Attribute_Declaration));
1639 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1640 end Set_Associative_Project_Of;
1642 --------------------------
1643 -- Set_Case_Insensitive --
1644 --------------------------
1646 procedure Set_Case_Insensitive
1647 (Node : Project_Node_Id;
1648 In_Tree : Project_Node_Tree_Ref;
1649 To : Boolean)
1651 begin
1652 pragma Assert
1653 (Node /= Empty_Node
1654 and then
1655 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1656 or else
1657 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1658 In_Tree.Project_Nodes.Table (Node).Flag1 := To;
1659 end Set_Case_Insensitive;
1661 ------------------------------------
1662 -- Set_Case_Variable_Reference_Of --
1663 ------------------------------------
1665 procedure Set_Case_Variable_Reference_Of
1666 (Node : Project_Node_Id;
1667 In_Tree : Project_Node_Tree_Ref;
1668 To : Project_Node_Id)
1670 begin
1671 pragma Assert
1672 (Node /= Empty_Node
1673 and then
1674 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1675 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1676 end Set_Case_Variable_Reference_Of;
1678 ---------------------------
1679 -- Set_Current_Item_Node --
1680 ---------------------------
1682 procedure Set_Current_Item_Node
1683 (Node : Project_Node_Id;
1684 In_Tree : Project_Node_Tree_Ref;
1685 To : Project_Node_Id)
1687 begin
1688 pragma Assert
1689 (Node /= Empty_Node
1690 and then
1691 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1692 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1693 end Set_Current_Item_Node;
1695 ----------------------
1696 -- Set_Current_Term --
1697 ----------------------
1699 procedure Set_Current_Term
1700 (Node : Project_Node_Id;
1701 In_Tree : Project_Node_Tree_Ref;
1702 To : Project_Node_Id)
1704 begin
1705 pragma Assert
1706 (Node /= Empty_Node
1707 and then
1708 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1709 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1710 end Set_Current_Term;
1712 ----------------------
1713 -- Set_Directory_Of --
1714 ----------------------
1716 procedure Set_Directory_Of
1717 (Node : Project_Node_Id;
1718 In_Tree : Project_Node_Tree_Ref;
1719 To : Name_Id)
1721 begin
1722 pragma Assert
1723 (Node /= Empty_Node
1724 and then
1725 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1726 In_Tree.Project_Nodes.Table (Node).Directory := To;
1727 end Set_Directory_Of;
1729 ---------------------
1730 -- Set_End_Of_Line --
1731 ---------------------
1733 procedure Set_End_Of_Line (To : Project_Node_Id) is
1734 begin
1735 End_Of_Line_Node := To;
1736 end Set_End_Of_Line;
1738 ----------------------------
1739 -- Set_Expression_Kind_Of --
1740 ----------------------------
1742 procedure Set_Expression_Kind_Of
1743 (Node : Project_Node_Id;
1744 In_Tree : Project_Node_Tree_Ref;
1745 To : Variable_Kind)
1747 begin
1748 pragma Assert
1749 (Node /= Empty_Node
1750 and then
1751 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
1752 or else
1753 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1754 or else
1755 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
1756 or else
1757 In_Tree.Project_Nodes.Table (Node).Kind =
1758 N_Typed_Variable_Declaration
1759 or else
1760 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
1761 or else
1762 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
1763 or else
1764 In_Tree.Project_Nodes.Table (Node).Kind = N_Term
1765 or else
1766 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1767 or else
1768 In_Tree.Project_Nodes.Table (Node).Kind =
1769 N_Attribute_Reference));
1770 In_Tree.Project_Nodes.Table (Node).Expr_Kind := To;
1771 end Set_Expression_Kind_Of;
1773 -----------------------
1774 -- Set_Expression_Of --
1775 -----------------------
1777 procedure Set_Expression_Of
1778 (Node : Project_Node_Id;
1779 In_Tree : Project_Node_Tree_Ref;
1780 To : Project_Node_Id)
1782 begin
1783 pragma Assert
1784 (Node /= Empty_Node
1785 and then
1786 (In_Tree.Project_Nodes.Table (Node).Kind =
1787 N_Attribute_Declaration
1788 or else
1789 In_Tree.Project_Nodes.Table (Node).Kind =
1790 N_Typed_Variable_Declaration
1791 or else
1792 In_Tree.Project_Nodes.Table (Node).Kind =
1793 N_Variable_Declaration));
1794 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1795 end Set_Expression_Of;
1797 -------------------------------
1798 -- Set_External_Reference_Of --
1799 -------------------------------
1801 procedure Set_External_Reference_Of
1802 (Node : Project_Node_Id;
1803 In_Tree : Project_Node_Tree_Ref;
1804 To : Project_Node_Id)
1806 begin
1807 pragma Assert
1808 (Node /= Empty_Node
1809 and then
1810 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
1811 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1812 end Set_External_Reference_Of;
1814 -----------------------------
1815 -- Set_External_Default_Of --
1816 -----------------------------
1818 procedure Set_External_Default_Of
1819 (Node : Project_Node_Id;
1820 In_Tree : Project_Node_Tree_Ref;
1821 To : Project_Node_Id)
1823 begin
1824 pragma Assert
1825 (Node /= Empty_Node
1826 and then
1827 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
1828 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1829 end Set_External_Default_Of;
1831 ----------------------------
1832 -- Set_First_Case_Item_Of --
1833 ----------------------------
1835 procedure Set_First_Case_Item_Of
1836 (Node : Project_Node_Id;
1837 In_Tree : Project_Node_Tree_Ref;
1838 To : Project_Node_Id)
1840 begin
1841 pragma Assert
1842 (Node /= Empty_Node
1843 and then
1844 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1845 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1846 end Set_First_Case_Item_Of;
1848 -------------------------
1849 -- Set_First_Choice_Of --
1850 -------------------------
1852 procedure Set_First_Choice_Of
1853 (Node : Project_Node_Id;
1854 In_Tree : Project_Node_Tree_Ref;
1855 To : Project_Node_Id)
1857 begin
1858 pragma Assert
1859 (Node /= Empty_Node
1860 and then
1861 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1862 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1863 end Set_First_Choice_Of;
1865 -----------------------------
1866 -- Set_First_Comment_After --
1867 -----------------------------
1869 procedure Set_First_Comment_After
1870 (Node : Project_Node_Id;
1871 In_Tree : Project_Node_Tree_Ref;
1872 To : Project_Node_Id)
1874 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1875 begin
1876 In_Tree.Project_Nodes.Table (Zone).Field2 := To;
1877 end Set_First_Comment_After;
1879 ---------------------------------
1880 -- Set_First_Comment_After_End --
1881 ---------------------------------
1883 procedure Set_First_Comment_After_End
1884 (Node : Project_Node_Id;
1885 In_Tree : Project_Node_Tree_Ref;
1886 To : Project_Node_Id)
1888 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1889 begin
1890 In_Tree.Project_Nodes.Table (Zone).Comments := To;
1891 end Set_First_Comment_After_End;
1893 ------------------------------
1894 -- Set_First_Comment_Before --
1895 ------------------------------
1897 procedure Set_First_Comment_Before
1898 (Node : Project_Node_Id;
1899 In_Tree : Project_Node_Tree_Ref;
1900 To : Project_Node_Id)
1903 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1904 begin
1905 In_Tree.Project_Nodes.Table (Zone).Field1 := To;
1906 end Set_First_Comment_Before;
1908 ----------------------------------
1909 -- Set_First_Comment_Before_End --
1910 ----------------------------------
1912 procedure Set_First_Comment_Before_End
1913 (Node : Project_Node_Id;
1914 In_Tree : Project_Node_Tree_Ref;
1915 To : Project_Node_Id)
1917 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1918 begin
1919 In_Tree.Project_Nodes.Table (Zone).Field2 := To;
1920 end Set_First_Comment_Before_End;
1922 ------------------------
1923 -- Set_Next_Case_Item --
1924 ------------------------
1926 procedure Set_Next_Case_Item
1927 (Node : Project_Node_Id;
1928 In_Tree : Project_Node_Tree_Ref;
1929 To : Project_Node_Id)
1931 begin
1932 pragma Assert
1933 (Node /= Empty_Node
1934 and then
1935 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1936 In_Tree.Project_Nodes.Table (Node).Field3 := To;
1937 end Set_Next_Case_Item;
1939 ----------------------
1940 -- Set_Next_Comment --
1941 ----------------------
1943 procedure Set_Next_Comment
1944 (Node : Project_Node_Id;
1945 In_Tree : Project_Node_Tree_Ref;
1946 To : Project_Node_Id)
1948 begin
1949 pragma Assert
1950 (Node /= Empty_Node
1951 and then
1952 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1953 In_Tree.Project_Nodes.Table (Node).Comments := To;
1954 end Set_Next_Comment;
1956 -----------------------------------
1957 -- Set_First_Declarative_Item_Of --
1958 -----------------------------------
1960 procedure Set_First_Declarative_Item_Of
1961 (Node : Project_Node_Id;
1962 In_Tree : Project_Node_Tree_Ref;
1963 To : Project_Node_Id)
1965 begin
1966 pragma Assert
1967 (Node /= Empty_Node
1968 and then
1969 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
1970 or else
1971 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
1972 or else
1973 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
1975 if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
1976 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1977 else
1978 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1979 end if;
1980 end Set_First_Declarative_Item_Of;
1982 ----------------------------------
1983 -- Set_First_Expression_In_List --
1984 ----------------------------------
1986 procedure Set_First_Expression_In_List
1987 (Node : Project_Node_Id;
1988 In_Tree : Project_Node_Tree_Ref;
1989 To : Project_Node_Id)
1991 begin
1992 pragma Assert
1993 (Node /= Empty_Node
1994 and then
1995 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
1996 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1997 end Set_First_Expression_In_List;
1999 ------------------------------
2000 -- Set_First_Literal_String --
2001 ------------------------------
2003 procedure Set_First_Literal_String
2004 (Node : Project_Node_Id;
2005 In_Tree : Project_Node_Tree_Ref;
2006 To : Project_Node_Id)
2008 begin
2009 pragma Assert
2010 (Node /= Empty_Node
2011 and then
2012 In_Tree.Project_Nodes.Table (Node).Kind =
2013 N_String_Type_Declaration);
2014 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2015 end Set_First_Literal_String;
2017 --------------------------
2018 -- Set_First_Package_Of --
2019 --------------------------
2021 procedure Set_First_Package_Of
2022 (Node : Project_Node_Id;
2023 In_Tree : Project_Node_Tree_Ref;
2024 To : Package_Declaration_Id)
2026 begin
2027 pragma Assert
2028 (Node /= Empty_Node
2029 and then
2030 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2031 In_Tree.Project_Nodes.Table (Node).Packages := To;
2032 end Set_First_Package_Of;
2034 ------------------------------
2035 -- Set_First_String_Type_Of --
2036 ------------------------------
2038 procedure Set_First_String_Type_Of
2039 (Node : Project_Node_Id;
2040 In_Tree : Project_Node_Tree_Ref;
2041 To : Project_Node_Id)
2043 begin
2044 pragma Assert
2045 (Node /= Empty_Node
2046 and then
2047 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2048 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2049 end Set_First_String_Type_Of;
2051 --------------------
2052 -- Set_First_Term --
2053 --------------------
2055 procedure Set_First_Term
2056 (Node : Project_Node_Id;
2057 In_Tree : Project_Node_Tree_Ref;
2058 To : Project_Node_Id)
2060 begin
2061 pragma Assert
2062 (Node /= Empty_Node
2063 and then
2064 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2065 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2066 end Set_First_Term;
2068 ---------------------------
2069 -- Set_First_Variable_Of --
2070 ---------------------------
2072 procedure Set_First_Variable_Of
2073 (Node : Project_Node_Id;
2074 In_Tree : Project_Node_Tree_Ref;
2075 To : Variable_Node_Id)
2077 begin
2078 pragma Assert
2079 (Node /= Empty_Node
2080 and then
2081 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2082 or else
2083 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2084 In_Tree.Project_Nodes.Table (Node).Variables := To;
2085 end Set_First_Variable_Of;
2087 ------------------------------
2088 -- Set_First_With_Clause_Of --
2089 ------------------------------
2091 procedure Set_First_With_Clause_Of
2092 (Node : Project_Node_Id;
2093 In_Tree : Project_Node_Tree_Ref;
2094 To : Project_Node_Id)
2096 begin
2097 pragma Assert
2098 (Node /= Empty_Node
2099 and then
2100 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2101 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2102 end Set_First_With_Clause_Of;
2104 --------------------------
2105 -- Set_Is_Extending_All --
2106 --------------------------
2108 procedure Set_Is_Extending_All
2109 (Node : Project_Node_Id;
2110 In_Tree : Project_Node_Tree_Ref)
2112 begin
2113 pragma Assert
2114 (Node /= Empty_Node
2115 and then
2116 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2117 or else
2118 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2119 In_Tree.Project_Nodes.Table (Node).Flag2 := True;
2120 end Set_Is_Extending_All;
2122 -----------------------------
2123 -- Set_Is_Not_Last_In_List --
2124 -----------------------------
2126 procedure Set_Is_Not_Last_In_List
2127 (Node : Project_Node_Id;
2128 In_Tree : Project_Node_Tree_Ref)
2130 begin
2131 pragma Assert
2132 (Node /= Empty_Node
2133 and then
2134 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2135 In_Tree.Project_Nodes.Table (Node).Flag1 := True;
2136 end Set_Is_Not_Last_In_List;
2138 -----------------
2139 -- Set_Kind_Of --
2140 -----------------
2142 procedure Set_Kind_Of
2143 (Node : Project_Node_Id;
2144 In_Tree : Project_Node_Tree_Ref;
2145 To : Project_Node_Kind)
2147 begin
2148 pragma Assert (Node /= Empty_Node);
2149 In_Tree.Project_Nodes.Table (Node).Kind := To;
2150 end Set_Kind_Of;
2152 ---------------------
2153 -- Set_Location_Of --
2154 ---------------------
2156 procedure Set_Location_Of
2157 (Node : Project_Node_Id;
2158 In_Tree : Project_Node_Tree_Ref;
2159 To : Source_Ptr)
2161 begin
2162 pragma Assert (Node /= Empty_Node);
2163 In_Tree.Project_Nodes.Table (Node).Location := To;
2164 end Set_Location_Of;
2166 -----------------------------
2167 -- Set_Extended_Project_Of --
2168 -----------------------------
2170 procedure Set_Extended_Project_Of
2171 (Node : Project_Node_Id;
2172 In_Tree : Project_Node_Tree_Ref;
2173 To : Project_Node_Id)
2175 begin
2176 pragma Assert
2177 (Node /= Empty_Node
2178 and then
2179 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2180 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2181 end Set_Extended_Project_Of;
2183 ----------------------------------
2184 -- Set_Extended_Project_Path_Of --
2185 ----------------------------------
2187 procedure Set_Extended_Project_Path_Of
2188 (Node : Project_Node_Id;
2189 In_Tree : Project_Node_Tree_Ref;
2190 To : Name_Id)
2192 begin
2193 pragma Assert
2194 (Node /= Empty_Node
2195 and then
2196 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2197 In_Tree.Project_Nodes.Table (Node).Value := To;
2198 end Set_Extended_Project_Path_Of;
2200 ------------------------------
2201 -- Set_Extending_Project_Of --
2202 ------------------------------
2204 procedure Set_Extending_Project_Of
2205 (Node : Project_Node_Id;
2206 In_Tree : Project_Node_Tree_Ref;
2207 To : Project_Node_Id)
2209 begin
2210 pragma Assert
2211 (Node /= Empty_Node
2212 and then
2213 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2214 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2215 end Set_Extending_Project_Of;
2217 -----------------
2218 -- Set_Name_Of --
2219 -----------------
2221 procedure Set_Name_Of
2222 (Node : Project_Node_Id;
2223 In_Tree : Project_Node_Tree_Ref;
2224 To : Name_Id)
2226 begin
2227 pragma Assert (Node /= Empty_Node);
2228 In_Tree.Project_Nodes.Table (Node).Name := To;
2229 end Set_Name_Of;
2231 -------------------------------
2232 -- Set_Next_Declarative_Item --
2233 -------------------------------
2235 procedure Set_Next_Declarative_Item
2236 (Node : Project_Node_Id;
2237 In_Tree : Project_Node_Tree_Ref;
2238 To : Project_Node_Id)
2240 begin
2241 pragma Assert
2242 (Node /= Empty_Node
2243 and then
2244 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
2245 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2246 end Set_Next_Declarative_Item;
2248 -----------------------
2249 -- Set_Next_End_Node --
2250 -----------------------
2252 procedure Set_Next_End_Node (To : Project_Node_Id) is
2253 begin
2254 Next_End_Nodes.Increment_Last;
2255 Next_End_Nodes.Table (Next_End_Nodes.Last) := To;
2256 end Set_Next_End_Node;
2258 ---------------------------------
2259 -- Set_Next_Expression_In_List --
2260 ---------------------------------
2262 procedure Set_Next_Expression_In_List
2263 (Node : Project_Node_Id;
2264 In_Tree : Project_Node_Tree_Ref;
2265 To : Project_Node_Id)
2267 begin
2268 pragma Assert
2269 (Node /= Empty_Node
2270 and then
2271 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2272 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2273 end Set_Next_Expression_In_List;
2275 -----------------------------
2276 -- Set_Next_Literal_String --
2277 -----------------------------
2279 procedure Set_Next_Literal_String
2280 (Node : Project_Node_Id;
2281 In_Tree : Project_Node_Tree_Ref;
2282 To : Project_Node_Id)
2284 begin
2285 pragma Assert
2286 (Node /= Empty_Node
2287 and then
2288 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
2289 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2290 end Set_Next_Literal_String;
2292 ---------------------------------
2293 -- Set_Next_Package_In_Project --
2294 ---------------------------------
2296 procedure Set_Next_Package_In_Project
2297 (Node : Project_Node_Id;
2298 In_Tree : Project_Node_Tree_Ref;
2299 To : Project_Node_Id)
2301 begin
2302 pragma Assert
2303 (Node /= Empty_Node
2304 and then
2305 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2306 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2307 end Set_Next_Package_In_Project;
2309 --------------------------
2310 -- Set_Next_String_Type --
2311 --------------------------
2313 procedure Set_Next_String_Type
2314 (Node : Project_Node_Id;
2315 In_Tree : Project_Node_Tree_Ref;
2316 To : Project_Node_Id)
2318 begin
2319 pragma Assert
2320 (Node /= Empty_Node
2321 and then
2322 In_Tree.Project_Nodes.Table (Node).Kind =
2323 N_String_Type_Declaration);
2324 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2325 end Set_Next_String_Type;
2327 -------------------
2328 -- Set_Next_Term --
2329 -------------------
2331 procedure Set_Next_Term
2332 (Node : Project_Node_Id;
2333 In_Tree : Project_Node_Tree_Ref;
2334 To : Project_Node_Id)
2336 begin
2337 pragma Assert
2338 (Node /= Empty_Node
2339 and then
2340 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
2341 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2342 end Set_Next_Term;
2344 -----------------------
2345 -- Set_Next_Variable --
2346 -----------------------
2348 procedure Set_Next_Variable
2349 (Node : Project_Node_Id;
2350 In_Tree : Project_Node_Tree_Ref;
2351 To : Project_Node_Id)
2353 begin
2354 pragma Assert
2355 (Node /= Empty_Node
2356 and then
2357 (In_Tree.Project_Nodes.Table (Node).Kind =
2358 N_Typed_Variable_Declaration
2359 or else
2360 In_Tree.Project_Nodes.Table (Node).Kind =
2361 N_Variable_Declaration));
2362 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2363 end Set_Next_Variable;
2365 -----------------------------
2366 -- Set_Next_With_Clause_Of --
2367 -----------------------------
2369 procedure Set_Next_With_Clause_Of
2370 (Node : Project_Node_Id;
2371 In_Tree : Project_Node_Tree_Ref;
2372 To : Project_Node_Id)
2374 begin
2375 pragma Assert
2376 (Node /= Empty_Node
2377 and then
2378 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2379 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2380 end Set_Next_With_Clause_Of;
2382 -----------------------
2383 -- Set_Package_Id_Of --
2384 -----------------------
2386 procedure Set_Package_Id_Of
2387 (Node : Project_Node_Id;
2388 In_Tree : Project_Node_Tree_Ref;
2389 To : Package_Node_Id)
2391 begin
2392 pragma Assert
2393 (Node /= Empty_Node
2394 and then
2395 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2396 In_Tree.Project_Nodes.Table (Node).Pkg_Id := To;
2397 end Set_Package_Id_Of;
2399 -------------------------
2400 -- Set_Package_Node_Of --
2401 -------------------------
2403 procedure Set_Package_Node_Of
2404 (Node : Project_Node_Id;
2405 In_Tree : Project_Node_Tree_Ref;
2406 To : Project_Node_Id)
2408 begin
2409 pragma Assert
2410 (Node /= Empty_Node
2411 and then
2412 (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2413 or else
2414 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2415 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2416 end Set_Package_Node_Of;
2418 ----------------------
2419 -- Set_Path_Name_Of --
2420 ----------------------
2422 procedure Set_Path_Name_Of
2423 (Node : Project_Node_Id;
2424 In_Tree : Project_Node_Tree_Ref;
2425 To : Name_Id)
2427 begin
2428 pragma Assert
2429 (Node /= Empty_Node
2430 and then
2431 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2432 or else
2433 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2434 In_Tree.Project_Nodes.Table (Node).Path_Name := To;
2435 end Set_Path_Name_Of;
2437 ---------------------------
2438 -- Set_Previous_End_Node --
2439 ---------------------------
2440 procedure Set_Previous_End_Node (To : Project_Node_Id) is
2441 begin
2442 Previous_End_Node := To;
2443 end Set_Previous_End_Node;
2445 ----------------------------
2446 -- Set_Previous_Line_Node --
2447 ----------------------------
2449 procedure Set_Previous_Line_Node (To : Project_Node_Id) is
2450 begin
2451 Previous_Line_Node := To;
2452 end Set_Previous_Line_Node;
2454 --------------------------------
2455 -- Set_Project_Declaration_Of --
2456 --------------------------------
2458 procedure Set_Project_Declaration_Of
2459 (Node : Project_Node_Id;
2460 In_Tree : Project_Node_Tree_Ref;
2461 To : Project_Node_Id)
2463 begin
2464 pragma Assert
2465 (Node /= Empty_Node
2466 and then
2467 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2468 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2469 end Set_Project_Declaration_Of;
2471 -----------------------------------------------
2472 -- Set_Project_File_Includes_Unkept_Comments --
2473 -----------------------------------------------
2475 procedure Set_Project_File_Includes_Unkept_Comments
2476 (Node : Project_Node_Id;
2477 In_Tree : Project_Node_Tree_Ref;
2478 To : Boolean)
2480 Declaration : constant Project_Node_Id :=
2481 Project_Declaration_Of (Node, In_Tree);
2482 begin
2483 In_Tree.Project_Nodes.Table (Declaration).Flag1 := To;
2484 end Set_Project_File_Includes_Unkept_Comments;
2486 -------------------------
2487 -- Set_Project_Node_Of --
2488 -------------------------
2490 procedure Set_Project_Node_Of
2491 (Node : Project_Node_Id;
2492 In_Tree : Project_Node_Tree_Ref;
2493 To : Project_Node_Id;
2494 Limited_With : Boolean := False)
2496 begin
2497 pragma Assert
2498 (Node /= Empty_Node
2499 and then
2500 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2501 or else
2502 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2503 or else
2504 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2505 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2507 if In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2508 and then not Limited_With
2509 then
2510 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2511 end if;
2512 end Set_Project_Node_Of;
2514 ---------------------------------------
2515 -- Set_Project_Of_Renamed_Package_Of --
2516 ---------------------------------------
2518 procedure Set_Project_Of_Renamed_Package_Of
2519 (Node : Project_Node_Id;
2520 In_Tree : Project_Node_Tree_Ref;
2521 To : Project_Node_Id)
2523 begin
2524 pragma Assert
2525 (Node /= Empty_Node
2526 and then
2527 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2528 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2529 end Set_Project_Of_Renamed_Package_Of;
2531 -------------------------
2532 -- Set_Source_Index_Of --
2533 -------------------------
2535 procedure Set_Source_Index_Of
2536 (Node : Project_Node_Id;
2537 In_Tree : Project_Node_Tree_Ref;
2538 To : Int)
2540 begin
2541 pragma Assert
2542 (Node /= Empty_Node
2543 and then
2544 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2545 or else
2546 In_Tree.Project_Nodes.Table (Node).Kind =
2547 N_Attribute_Declaration));
2548 In_Tree.Project_Nodes.Table (Node).Src_Index := To;
2549 end Set_Source_Index_Of;
2551 ------------------------
2552 -- Set_String_Type_Of --
2553 ------------------------
2555 procedure Set_String_Type_Of
2556 (Node : Project_Node_Id;
2557 In_Tree : Project_Node_Tree_Ref;
2558 To : Project_Node_Id)
2560 begin
2561 pragma Assert
2562 (Node /= Empty_Node
2563 and then
2564 (In_Tree.Project_Nodes.Table (Node).Kind =
2565 N_Variable_Reference
2566 or else
2567 In_Tree.Project_Nodes.Table (Node).Kind =
2568 N_Typed_Variable_Declaration)
2569 and then
2570 In_Tree.Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
2572 if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2573 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2574 else
2575 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2576 end if;
2577 end Set_String_Type_Of;
2579 -------------------------
2580 -- Set_String_Value_Of --
2581 -------------------------
2583 procedure Set_String_Value_Of
2584 (Node : Project_Node_Id;
2585 In_Tree : Project_Node_Tree_Ref;
2586 To : Name_Id)
2588 begin
2589 pragma Assert
2590 (Node /= Empty_Node
2591 and then
2592 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2593 or else
2594 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2595 or else
2596 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2597 In_Tree.Project_Nodes.Table (Node).Value := To;
2598 end Set_String_Value_Of;
2600 ---------------------
2601 -- Source_Index_Of --
2602 ---------------------
2604 function Source_Index_Of
2605 (Node : Project_Node_Id;
2606 In_Tree : Project_Node_Tree_Ref) return Int
2608 begin
2609 pragma Assert
2610 (Node /= Empty_Node
2611 and then
2612 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2613 or else
2614 In_Tree.Project_Nodes.Table (Node).Kind =
2615 N_Attribute_Declaration));
2616 return In_Tree.Project_Nodes.Table (Node).Src_Index;
2617 end Source_Index_Of;
2619 --------------------
2620 -- String_Type_Of --
2621 --------------------
2623 function String_Type_Of
2624 (Node : Project_Node_Id;
2625 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
2627 begin
2628 pragma Assert
2629 (Node /= Empty_Node
2630 and then
2631 (In_Tree.Project_Nodes.Table (Node).Kind =
2632 N_Variable_Reference
2633 or else
2634 In_Tree.Project_Nodes.Table (Node).Kind =
2635 N_Typed_Variable_Declaration));
2637 if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2638 return In_Tree.Project_Nodes.Table (Node).Field3;
2639 else
2640 return In_Tree.Project_Nodes.Table (Node).Field2;
2641 end if;
2642 end String_Type_Of;
2644 ---------------------
2645 -- String_Value_Of --
2646 ---------------------
2648 function String_Value_Of
2649 (Node : Project_Node_Id;
2650 In_Tree : Project_Node_Tree_Ref) return Name_Id
2652 begin
2653 pragma Assert
2654 (Node /= Empty_Node
2655 and then
2656 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2657 or else
2658 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2659 or else
2660 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2661 return In_Tree.Project_Nodes.Table (Node).Value;
2662 end String_Value_Of;
2664 --------------------
2665 -- Value_Is_Valid --
2666 --------------------
2668 function Value_Is_Valid
2669 (For_Typed_Variable : Project_Node_Id;
2670 In_Tree : Project_Node_Tree_Ref;
2671 Value : Name_Id) return Boolean
2673 begin
2674 pragma Assert
2675 (For_Typed_Variable /= Empty_Node
2676 and then
2677 (In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind =
2678 N_Typed_Variable_Declaration));
2680 declare
2681 Current_String : Project_Node_Id :=
2682 First_Literal_String
2683 (String_Type_Of (For_Typed_Variable, In_Tree),
2684 In_Tree);
2686 begin
2687 while Current_String /= Empty_Node
2688 and then
2689 String_Value_Of (Current_String, In_Tree) /= Value
2690 loop
2691 Current_String :=
2692 Next_Literal_String (Current_String, In_Tree);
2693 end loop;
2695 return Current_String /= Empty_Node;
2696 end;
2698 end Value_Is_Valid;
2700 -------------------------------
2701 -- There_Are_Unkept_Comments --
2702 -------------------------------
2704 function There_Are_Unkept_Comments return Boolean is
2705 begin
2706 return Unkept_Comments;
2707 end There_Are_Unkept_Comments;
2709 end Prj.Tree;