projects / gcc.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
exp_atag.ads, [...]: Replace headers with GPL v3 headers.
[gcc.git] / gcc / ada / prj-tree.adb
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 ------------------------------------------------------------------------------
25
26 with Prj.Err;
27
28 package body Prj.Tree is
29
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
52
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
61
62 use Tree_Private_Part;
63
64 End_Of_Line_Node : Project_Node_Id := Empty_Node;
65 -- The node an end of line comment may be associated with
66
67 Previous_Line_Node : Project_Node_Id := Empty_Node;
68 -- The node an immediately following comment may be associated with
69
70 Previous_End_Node : Project_Node_Id := Empty_Node;
71 -- The node comments immediately following an "end" line may be
72 -- associated with.
73
74 Unkept_Comments : Boolean := False;
75 -- Set to True when some comments may not be associated with any node
76
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.
83
84 ------------------
85 -- Add_Comments --
86 ------------------
87
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;
94
95 begin
96 pragma Assert
97 (To /= Empty_Node
98 and then
99 In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
100
101 Zone := In_Tree.Project_Nodes.Table (To).Comments;
102
103 if Zone = Empty_Node then
104
105 -- Create new N_Comment_Zones node
106
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);
127
128 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
129 In_Tree.Project_Nodes.Table (To).Comments := Zone;
130 end if;
131
132 if Where = End_Of_Line then
133 In_Tree.Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
134
135 else
136 -- Get each comments in the Comments table and link them to node To
137
138 for J in 1 .. Comments.Last loop
139
140 -- Create new N_Comment node
141
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;
151
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);
173
174 -- If this is the first comment, put it in the right field of
175 -- the node Zone.
176
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);
182
183 when After =>
184 In_Tree.Project_Nodes.Table (Zone).Field2 :=
185 Project_Node_Table.Last (In_Tree.Project_Nodes);
186
187 when Before_End =>
188 In_Tree.Project_Nodes.Table (Zone).Field3 :=
189 Project_Node_Table.Last (In_Tree.Project_Nodes);
190
191 when After_End =>
192 In_Tree.Project_Nodes.Table (Zone).Comments :=
193 Project_Node_Table.Last (In_Tree.Project_Nodes);
194
195 when End_Of_Line =>
196 null;
197 end case;
198
199 else
200 -- When it is not the first, link it to the previous one
201
202 In_Tree.Project_Nodes.Table (Previous).Comments :=
203 Project_Node_Table.Last (In_Tree.Project_Nodes);
204 end if;
205
206 -- This node becomes the previous one for the next comment, if
207 -- there is one.
208
209 Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
210 end loop;
211 end if;
212
213 -- Empty the Comments table, so that there is no risk to link the same
214 -- comments to another node.
215
216 Comments.Set_Last (0);
217 end Add_Comments;
218
219 --------------------------------
220 -- Associative_Array_Index_Of --
221 --------------------------------
222
223 function Associative_Array_Index_Of
224 (Node : Project_Node_Id;
225 In_Tree : Project_Node_Tree_Ref) return Name_Id
226 is
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;
236
237 ----------------------------
238 -- Associative_Package_Of --
239 ----------------------------
240
241 function Associative_Package_Of
242 (Node : Project_Node_Id;
243 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
244 is
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;
252
253 ----------------------------
254 -- Associative_Project_Of --
255 ----------------------------
256
257 function Associative_Project_Of
258 (Node : Project_Node_Id;
259 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
260 is
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;
268
269 ----------------------
270 -- Case_Insensitive --
271 ----------------------
272
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;
285
286 --------------------------------
287 -- Case_Variable_Reference_Of --
288 --------------------------------
289
290 function Case_Variable_Reference_Of
291 (Node : Project_Node_Id;
292 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
293 is
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;
301
302 ----------------------
303 -- Comment_Zones_Of --
304 ----------------------
305
306 function Comment_Zones_Of
307 (Node : Project_Node_Id;
308 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
309 is
310 Zone : Project_Node_Id;
311
312 begin
313 pragma Assert (Node /= Empty_Node);
314 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
315
316 -- If there is not already an N_Comment_Zones associated, create a new
317 -- one and associate it with node Node.
318
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;
342
343 return Zone;
344 end Comment_Zones_Of;
345
346 -----------------------
347 -- Current_Item_Node --
348 -----------------------
349
350 function Current_Item_Node
351 (Node : Project_Node_Id;
352 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
353 is
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;
361
362 ------------------
363 -- Current_Term --
364 ------------------
365
366 function Current_Term
367 (Node : Project_Node_Id;
368 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
369 is
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;
377
378 --------------------------
379 -- Default_Project_Node --
380 --------------------------
381
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
386 is
387 Result : Project_Node_Id;
388 Zone : Project_Node_Id;
389 Previous : Project_Node_Id;
390
391 begin
392 -- Create new node with specified kind and expression kind
393
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);
414
415 -- Save the new node for the returned value
416
417 Result := Project_Node_Table.Last (In_Tree.Project_Nodes);
418
419 if Comments.Last > 0 then
420
421 -- If this is not a node with comments, then set the flag
422
423 if not Node_With_Comments (Of_Kind) then
424 Unkept_Comments := True;
425
426 elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then
427
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);
448
449 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
450 In_Tree.Project_Nodes.Table (Result).Comments := Zone;
451 Previous := Empty_Node;
452
453 for J in 1 .. Comments.Last loop
454
455 -- Create a new N_Comment node
456
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);
478
479 -- Link it to the N_Comment_Zones node, if it is the first,
480 -- otherwise to the previous one.
481
482 if Previous = Empty_Node then
483 In_Tree.Project_Nodes.Table (Zone).Field1 :=
484 Project_Node_Table.Last (In_Tree.Project_Nodes);
485
486 else
487 In_Tree.Project_Nodes.Table (Previous).Comments :=
488 Project_Node_Table.Last (In_Tree.Project_Nodes);
489 end if;
490
491 -- This new node will be the previous one for the next
492 -- N_Comment node, if there is one.
493
494 Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
495 end loop;
496
497 -- Empty the Comments table after all comments have been processed
498
499 Comments.Set_Last (0);
500 end if;
501 end if;
502
503 return Result;
504 end Default_Project_Node;
505
506 ------------------
507 -- Directory_Of --
508 ------------------
509
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;
520
521 -------------------------
522 -- End_Of_Line_Comment --
523 -------------------------
524
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;
529
530 begin
531 pragma Assert (Node /= Empty_Node);
532 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
533
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;
540
541 ------------------------
542 -- Expression_Kind_Of --
543 ------------------------
544
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));
571
572 return In_Tree.Project_Nodes.Table (Node).Expr_Kind;
573 end Expression_Kind_Of;
574
575 -------------------
576 -- Expression_Of --
577 -------------------
578
579 function Expression_Of
580 (Node : Project_Node_Id;
581 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
582 is
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));
595
596 return In_Tree.Project_Nodes.Table (Node).Field1;
597 end Expression_Of;
598
599 -------------------------
600 -- Extended_Project_Of --
601 -------------------------
602
603 function Extended_Project_Of
604 (Node : Project_Node_Id;
605 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
606 is
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;
614
615 ------------------------------
616 -- Extended_Project_Path_Of --
617 ------------------------------
618
619 function Extended_Project_Path_Of
620 (Node : Project_Node_Id;
621 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
622 is
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;
630
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
637 is
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;
645
646 ---------------------------
647 -- External_Reference_Of --
648 ---------------------------
649
650 function External_Reference_Of
651 (Node : Project_Node_Id;
652 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
653 is
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;
661
662 -------------------------
663 -- External_Default_Of --
664 -------------------------
665
666 function External_Default_Of
667 (Node : Project_Node_Id;
668 In_Tree : Project_Node_Tree_Ref)
669 return Project_Node_Id
670 is
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;
678
679 ------------------------
680 -- First_Case_Item_Of --
681 ------------------------
682
683 function First_Case_Item_Of
684 (Node : Project_Node_Id;
685 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
686 is
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;
694
695 ---------------------
696 -- First_Choice_Of --
697 ---------------------
698
699 function First_Choice_Of
700 (Node : Project_Node_Id;
701 In_Tree : Project_Node_Tree_Ref)
702 return Project_Node_Id
703 is
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;
711
712 -------------------------
713 -- First_Comment_After --
714 -------------------------
715
716 function First_Comment_After
717 (Node : Project_Node_Id;
718 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
719 is
720 Zone : Project_Node_Id := Empty_Node;
721 begin
722 pragma Assert (Node /= Empty_Node);
723 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
724
725 if Zone = Empty_Node then
726 return Empty_Node;
727
728 else
729 return In_Tree.Project_Nodes.Table (Zone).Field2;
730 end if;
731 end First_Comment_After;
732
733 -----------------------------
734 -- First_Comment_After_End --
735 -----------------------------
736
737 function First_Comment_After_End
738 (Node : Project_Node_Id;
739 In_Tree : Project_Node_Tree_Ref)
740 return Project_Node_Id
741 is
742 Zone : Project_Node_Id := Empty_Node;
743
744 begin
745 pragma Assert (Node /= Empty_Node);
746 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
747
748 if Zone = Empty_Node then
749 return Empty_Node;
750
751 else
752 return In_Tree.Project_Nodes.Table (Zone).Comments;
753 end if;
754 end First_Comment_After_End;
755
756 --------------------------
757 -- First_Comment_Before --
758 --------------------------
759
760 function First_Comment_Before
761 (Node : Project_Node_Id;
762 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
763 is
764 Zone : Project_Node_Id := Empty_Node;
765
766 begin
767 pragma Assert (Node /= Empty_Node);
768 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
769
770 if Zone = Empty_Node then
771 return Empty_Node;
772
773 else
774 return In_Tree.Project_Nodes.Table (Zone).Field1;
775 end if;
776 end First_Comment_Before;
777
778 ------------------------------
779 -- First_Comment_Before_End --
780 ------------------------------
781
782 function First_Comment_Before_End
783 (Node : Project_Node_Id;
784 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
785 is
786 Zone : Project_Node_Id := Empty_Node;
787
788 begin
789 pragma Assert (Node /= Empty_Node);
790 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
791
792 if Zone = Empty_Node then
793 return Empty_Node;
794
795 else
796 return In_Tree.Project_Nodes.Table (Zone).Field3;
797 end if;
798 end First_Comment_Before_End;
799
800 -------------------------------
801 -- First_Declarative_Item_Of --
802 -------------------------------
803
804 function First_Declarative_Item_Of
805 (Node : Project_Node_Id;
806 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
807 is
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));
817
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;
824
825 ------------------------------
826 -- First_Expression_In_List --
827 ------------------------------
828
829 function First_Expression_In_List
830 (Node : Project_Node_Id;
831 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
832 is
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;
840
841 --------------------------
842 -- First_Literal_String --
843 --------------------------
844
845 function First_Literal_String
846 (Node : Project_Node_Id;
847 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
848 is
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;
857
858 ----------------------
859 -- First_Package_Of --
860 ----------------------
861
862 function First_Package_Of
863 (Node : Project_Node_Id;
864 In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id
865 is
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;
873
874 --------------------------
875 -- First_String_Type_Of --
876 --------------------------
877
878 function First_String_Type_Of
879 (Node : Project_Node_Id;
880 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
881 is
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;
889
890 ----------------
891 -- First_Term --
892 ----------------
893
894 function First_Term
895 (Node : Project_Node_Id;
896 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
897 is
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;
905
906 -----------------------
907 -- First_Variable_Of --
908 -----------------------
909
910 function First_Variable_Of
911 (Node : Project_Node_Id;
912 In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id
913 is
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));
921
922 return In_Tree.Project_Nodes.Table (Node).Variables;
923 end First_Variable_Of;
924
925 --------------------------
926 -- First_With_Clause_Of --
927 --------------------------
928
929 function First_With_Clause_Of
930 (Node : Project_Node_Id;
931 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
932 is
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;
940
941 ------------------------
942 -- Follows_Empty_Line --
943 ------------------------
944
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;
955
956 ----------
957 -- Hash --
958 ----------
959
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;
964
965 ----------------
966 -- Initialize --
967 ----------------
968
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;
974
975 -------------------------------
976 -- Is_Followed_By_Empty_Line --
977 -------------------------------
978
979 function Is_Followed_By_Empty_Line
980 (Node : Project_Node_Id;
981 In_Tree : Project_Node_Tree_Ref) return Boolean
982 is
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;
990
991 ----------------------
992 -- Is_Extending_All --
993 ----------------------
994
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;
1007
1008 -------------------------
1009 -- Is_Not_Last_In_List --
1010 -------------------------
1011
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;
1022
1023 -------------------------------------
1024 -- Imported_Or_Extended_Project_Of --
1025 -------------------------------------
1026
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
1031 is
1032 With_Clause : Project_Node_Id :=
1033 First_With_Clause_Of (Project, In_Tree);
1034 Result : Project_Node_Id := Empty_Node;
1035
1036 begin
1037 -- First check all the imported projects
1038
1039 while With_Clause /= Empty_Node loop
1040
1041 -- Only non limited imported project may be used as prefix
1042 -- of variable or attributes.
1043
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;
1049
1050 -- If it is not an imported project, it might be the imported project
1051
1052 if With_Clause = Empty_Node then
1053 Result :=
1054 Extended_Project_Of
1055 (Project_Declaration_Of (Project, In_Tree), In_Tree);
1056
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;
1063
1064 return Result;
1065 end Imported_Or_Extended_Project_Of;
1066
1067 -------------
1068 -- Kind_Of --
1069 -------------
1070
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;
1078
1079 -----------------
1080 -- Location_Of --
1081 -----------------
1082
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;
1090
1091 -------------
1092 -- Name_Of --
1093 -------------
1094
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;
1102
1103 --------------------
1104 -- Next_Case_Item --
1105 --------------------
1106
1107 function Next_Case_Item
1108 (Node : Project_Node_Id;
1109 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1110 is
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;
1118
1119 ------------------
1120 -- Next_Comment --
1121 ------------------
1122
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;
1133
1134 ---------------------------
1135 -- Next_Declarative_Item --
1136 ---------------------------
1137
1138 function Next_Declarative_Item
1139 (Node : Project_Node_Id;
1140 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1141 is
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;
1149
1150 -----------------------------
1151 -- Next_Expression_In_List --
1152 -----------------------------
1153
1154 function Next_Expression_In_List
1155 (Node : Project_Node_Id;
1156 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1157 is
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;
1165
1166 -------------------------
1167 -- Next_Literal_String --
1168 -------------------------
1169
1170 function Next_Literal_String
1171 (Node : Project_Node_Id;
1172 In_Tree : Project_Node_Tree_Ref)
1173 return Project_Node_Id
1174 is
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;
1182
1183 -----------------------------
1184 -- Next_Package_In_Project --
1185 -----------------------------
1186
1187 function Next_Package_In_Project
1188 (Node : Project_Node_Id;
1189 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1190 is
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;
1198
1199 ----------------------
1200 -- Next_String_Type --
1201 ----------------------
1202
1203 function Next_String_Type
1204 (Node : Project_Node_Id;
1205 In_Tree : Project_Node_Tree_Ref)
1206 return Project_Node_Id
1207 is
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;
1216
1217 ---------------
1218 -- Next_Term --
1219 ---------------
1220
1221 function Next_Term
1222 (Node : Project_Node_Id;
1223 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1224 is
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;
1232
1233 -------------------
1234 -- Next_Variable --
1235 -------------------
1236
1237 function Next_Variable
1238 (Node : Project_Node_Id;
1239 In_Tree : Project_Node_Tree_Ref)
1240 return Project_Node_Id
1241 is
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));
1251
1252 return In_Tree.Project_Nodes.Table (Node).Field3;
1253 end Next_Variable;
1254
1255 -------------------------
1256 -- Next_With_Clause_Of --
1257 -------------------------
1258
1259 function Next_With_Clause_Of
1260 (Node : Project_Node_Id;
1261 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1262 is
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;
1270
1271 ---------------------------------
1272 -- Non_Limited_Project_Node_Of --
1273 ---------------------------------
1274
1275 function Non_Limited_Project_Node_Of
1276 (Node : Project_Node_Id;
1277 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1278 is
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;
1286
1287 -------------------
1288 -- Package_Id_Of --
1289 -------------------
1290
1291 function Package_Id_Of
1292 (Node : Project_Node_Id;
1293 In_Tree : Project_Node_Tree_Ref) return Package_Node_Id
1294 is
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;
1302
1303 ---------------------
1304 -- Package_Node_Of --
1305 ---------------------
1306
1307 function Package_Node_Of
1308 (Node : Project_Node_Id;
1309 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1310 is
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;
1320
1321 ------------------
1322 -- Path_Name_Of --
1323 ------------------
1324
1325 function Path_Name_Of
1326 (Node : Project_Node_Id;
1327 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
1328 is
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;
1338
1339 ----------------------------
1340 -- Project_Declaration_Of --
1341 ----------------------------
1342
1343 function Project_Declaration_Of
1344 (Node : Project_Node_Id;
1345 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1346 is
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;
1354
1355 -------------------------------------------
1356 -- Project_File_Includes_Unkept_Comments --
1357 -------------------------------------------
1358
1359 function Project_File_Includes_Unkept_Comments
1360 (Node : Project_Node_Id;
1361 In_Tree : Project_Node_Tree_Ref) return Boolean
1362 is
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;
1368
1369 ---------------------
1370 -- Project_Node_Of --
1371 ---------------------
1372
1373 function Project_Node_Of
1374 (Node : Project_Node_Id;
1375 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1376 is
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;
1388
1389 -----------------------------------
1390 -- Project_Of_Renamed_Package_Of --
1391 -----------------------------------
1392
1393 function Project_Of_Renamed_Package_Of
1394 (Node : Project_Node_Id;
1395 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1396 is
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;
1404
1405 --------------------------
1406 -- Remove_Next_End_Node --
1407 --------------------------
1408
1409 procedure Remove_Next_End_Node is
1410 begin
1411 Next_End_Nodes.Decrement_Last;
1412 end Remove_Next_End_Node;
1413
1414 -----------------
1415 -- Reset_State --
1416 -----------------
1417
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;
1426
1427 -------------
1428 -- Restore --
1429 -------------
1430
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;
1438
1439 Comments.Set_Last (0);
1440
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;
1446
1447 ----------
1448 -- Save --
1449 ----------
1450
1451 procedure Save (S : out Comment_State) is
1452 Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last);
1453
1454 begin
1455 for J in 1 .. Comments.Last loop
1456 Cmts (J) := Comments.Table (J);
1457 end loop;
1458
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;
1466
1467 ----------
1468 -- Scan --
1469 ----------
1470
1471 procedure Scan (In_Tree : Project_Node_Tree_Ref) is
1472 Empty_Line : Boolean := False;
1473
1474 begin
1475 -- If there are comments, then they will not be kept. Set the flag and
1476 -- clear the comments.
1477
1478 if Comments.Last > 0 then
1479 Unkept_Comments := True;
1480 Comments.Set_Last (0);
1481 end if;
1482
1483 -- Loop until a token other that End_Of_Line or Comment is found
1484
1485 loop
1486 Prj.Err.Scanner.Scan;
1487
1488 case Token is
1489 when Tok_End_Of_Line =>
1490 if Prev_Token = Tok_End_Of_Line then
1491 Empty_Line := True;
1492
1493 if Comments.Last > 0 then
1494 Comments.Table (Comments.Last).Is_Followed_By_Empty_Line
1495 := True;
1496 end if;
1497 end if;
1498
1499 when Tok_Comment =>
1500 -- If this is a line comment, add it to the comment table
1501
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);
1510
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.
1514
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;
1522
1523 -- Otherwise, this end of line node cannot be kept
1524
1525 else
1526 Unkept_Comments := True;
1527 Comments.Set_Last (0);
1528 end if;
1529
1530 Empty_Line := False;
1531
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.
1537
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);
1545
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;
1553
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.
1558
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);
1565
1566 else
1567 Unkept_Comments := True;
1568 end if;
1569
1570 Comments.Set_Last (0);
1571 end if;
1572
1573 -- Reset the End_Of_Line, Previous_Line and Previous_End nodes
1574 -- so that they are not used again.
1575
1576 End_Of_Line_Node := Empty_Node;
1577 Previous_Line_Node := Empty_Node;
1578 Previous_End_Node := Empty_Node;
1579
1580 -- And return
1581
1582 exit;
1583 end case;
1584 end loop;
1585 end Scan;
1586
1587 ------------------------------------
1588 -- Set_Associative_Array_Index_Of --
1589 ------------------------------------
1590
1591 procedure Set_Associative_Array_Index_Of
1592 (Node : Project_Node_Id;
1593 In_Tree : Project_Node_Tree_Ref;
1594 To : Name_Id)
1595 is
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;
1605
1606 --------------------------------
1607 -- Set_Associative_Package_Of --
1608 --------------------------------
1609
1610 procedure Set_Associative_Package_Of
1611 (Node : Project_Node_Id;
1612 In_Tree : Project_Node_Tree_Ref;
1613 To : Project_Node_Id)
1614 is
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;
1622
1623 --------------------------------
1624 -- Set_Associative_Project_Of --
1625 --------------------------------
1626
1627 procedure Set_Associative_Project_Of
1628 (Node : Project_Node_Id;
1629 In_Tree : Project_Node_Tree_Ref;
1630 To : Project_Node_Id)
1631 is
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;
1640
1641 --------------------------
1642 -- Set_Case_Insensitive --
1643 --------------------------
1644
1645 procedure Set_Case_Insensitive
1646 (Node : Project_Node_Id;
1647 In_Tree : Project_Node_Tree_Ref;
1648 To : Boolean)
1649 is
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;
1659
1660 ------------------------------------
1661 -- Set_Case_Variable_Reference_Of --
1662 ------------------------------------
1663
1664 procedure Set_Case_Variable_Reference_Of
1665 (Node : Project_Node_Id;
1666 In_Tree : Project_Node_Tree_Ref;
1667 To : Project_Node_Id)
1668 is
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;
1676
1677 ---------------------------
1678 -- Set_Current_Item_Node --
1679 ---------------------------
1680
1681 procedure Set_Current_Item_Node
1682 (Node : Project_Node_Id;
1683 In_Tree : Project_Node_Tree_Ref;
1684 To : Project_Node_Id)
1685 is
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;
1693
1694 ----------------------
1695 -- Set_Current_Term --
1696 ----------------------
1697
1698 procedure Set_Current_Term
1699 (Node : Project_Node_Id;
1700 In_Tree : Project_Node_Tree_Ref;
1701 To : Project_Node_Id)
1702 is
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;
1710
1711 ----------------------
1712 -- Set_Directory_Of --
1713 ----------------------
1714
1715 procedure Set_Directory_Of
1716 (Node : Project_Node_Id;
1717 In_Tree : Project_Node_Tree_Ref;
1718 To : Path_Name_Type)
1719 is
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;
1727
1728 ---------------------
1729 -- Set_End_Of_Line --
1730 ---------------------
1731
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;
1736
1737 ----------------------------
1738 -- Set_Expression_Kind_Of --
1739 ----------------------------
1740
1741 procedure Set_Expression_Kind_Of
1742 (Node : Project_Node_Id;
1743 In_Tree : Project_Node_Tree_Ref;
1744 To : Variable_Kind)
1745 is
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;
1771
1772 -----------------------
1773 -- Set_Expression_Of --
1774 -----------------------
1775
1776 procedure Set_Expression_Of
1777 (Node : Project_Node_Id;
1778 In_Tree : Project_Node_Tree_Ref;
1779 To : Project_Node_Id)
1780 is
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;
1795
1796 -------------------------------
1797 -- Set_External_Reference_Of --
1798 -------------------------------
1799
1800 procedure Set_External_Reference_Of
1801 (Node : Project_Node_Id;
1802 In_Tree : Project_Node_Tree_Ref;
1803 To : Project_Node_Id)
1804 is
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;
1812
1813 -----------------------------
1814 -- Set_External_Default_Of --
1815 -----------------------------
1816
1817 procedure Set_External_Default_Of
1818 (Node : Project_Node_Id;
1819 In_Tree : Project_Node_Tree_Ref;
1820 To : Project_Node_Id)
1821 is
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;
1829
1830 ----------------------------
1831 -- Set_First_Case_Item_Of --
1832 ----------------------------
1833
1834 procedure Set_First_Case_Item_Of
1835 (Node : Project_Node_Id;
1836 In_Tree : Project_Node_Tree_Ref;
1837 To : Project_Node_Id)
1838 is
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;
1846
1847 -------------------------
1848 -- Set_First_Choice_Of --
1849 -------------------------
1850
1851 procedure Set_First_Choice_Of
1852 (Node : Project_Node_Id;
1853 In_Tree : Project_Node_Tree_Ref;
1854 To : Project_Node_Id)
1855 is
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;
1863
1864 -----------------------------
1865 -- Set_First_Comment_After --
1866 -----------------------------
1867
1868 procedure Set_First_Comment_After
1869 (Node : Project_Node_Id;
1870 In_Tree : Project_Node_Tree_Ref;
1871 To : Project_Node_Id)
1872 is
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;
1877
1878 ---------------------------------
1879 -- Set_First_Comment_After_End --
1880 ---------------------------------
1881
1882 procedure Set_First_Comment_After_End
1883 (Node : Project_Node_Id;
1884 In_Tree : Project_Node_Tree_Ref;
1885 To : Project_Node_Id)
1886 is
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;
1891
1892 ------------------------------
1893 -- Set_First_Comment_Before --
1894 ------------------------------
1895
1896 procedure Set_First_Comment_Before
1897 (Node : Project_Node_Id;
1898 In_Tree : Project_Node_Tree_Ref;
1899 To : Project_Node_Id)
1900
1901 is
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;
1906
1907 ----------------------------------
1908 -- Set_First_Comment_Before_End --
1909 ----------------------------------
1910
1911 procedure Set_First_Comment_Before_End
1912 (Node : Project_Node_Id;
1913 In_Tree : Project_Node_Tree_Ref;
1914 To : Project_Node_Id)
1915 is
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;
1920
1921 ------------------------
1922 -- Set_Next_Case_Item --
1923 ------------------------
1924
1925 procedure Set_Next_Case_Item
1926 (Node : Project_Node_Id;
1927 In_Tree : Project_Node_Tree_Ref;
1928 To : Project_Node_Id)
1929 is
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;
1937
1938 ----------------------
1939 -- Set_Next_Comment --
1940 ----------------------
1941
1942 procedure Set_Next_Comment
1943 (Node : Project_Node_Id;
1944 In_Tree : Project_Node_Tree_Ref;
1945 To : Project_Node_Id)
1946 is
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;
1954
1955 -----------------------------------
1956 -- Set_First_Declarative_Item_Of --
1957 -----------------------------------
1958
1959 procedure Set_First_Declarative_Item_Of
1960 (Node : Project_Node_Id;
1961 In_Tree : Project_Node_Tree_Ref;
1962 To : Project_Node_Id)
1963 is
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));
1973
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;
1980
1981 ----------------------------------
1982 -- Set_First_Expression_In_List --
1983 ----------------------------------
1984
1985 procedure Set_First_Expression_In_List
1986 (Node : Project_Node_Id;
1987 In_Tree : Project_Node_Tree_Ref;
1988 To : Project_Node_Id)
1989 is
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;
1997
1998 ------------------------------
1999 -- Set_First_Literal_String --
2000 ------------------------------
2001
2002 procedure Set_First_Literal_String
2003 (Node : Project_Node_Id;
2004 In_Tree : Project_Node_Tree_Ref;
2005 To : Project_Node_Id)
2006 is
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;
2015
2016 --------------------------
2017 -- Set_First_Package_Of --
2018 --------------------------
2019
2020 procedure Set_First_Package_Of
2021 (Node : Project_Node_Id;
2022 In_Tree : Project_Node_Tree_Ref;
2023 To : Package_Declaration_Id)
2024 is
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;
2032
2033 ------------------------------
2034 -- Set_First_String_Type_Of --
2035 ------------------------------
2036
2037 procedure Set_First_String_Type_Of
2038 (Node : Project_Node_Id;
2039 In_Tree : Project_Node_Tree_Ref;
2040 To : Project_Node_Id)
2041 is
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;
2049
2050 --------------------
2051 -- Set_First_Term --
2052 --------------------
2053
2054 procedure Set_First_Term
2055 (Node : Project_Node_Id;
2056 In_Tree : Project_Node_Tree_Ref;
2057 To : Project_Node_Id)
2058 is
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;
2066
2067 ---------------------------
2068 -- Set_First_Variable_Of --
2069 ---------------------------
2070
2071 procedure Set_First_Variable_Of
2072 (Node : Project_Node_Id;
2073 In_Tree : Project_Node_Tree_Ref;
2074 To : Variable_Node_Id)
2075 is
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;
2085
2086 ------------------------------
2087 -- Set_First_With_Clause_Of --
2088 ------------------------------
2089
2090 procedure Set_First_With_Clause_Of
2091 (Node : Project_Node_Id;
2092 In_Tree : Project_Node_Tree_Ref;
2093 To : Project_Node_Id)
2094 is
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;
2102
2103 --------------------------
2104 -- Set_Is_Extending_All --
2105 --------------------------
2106
2107 procedure Set_Is_Extending_All
2108 (Node : Project_Node_Id;
2109 In_Tree : Project_Node_Tree_Ref)
2110 is
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;
2120
2121 -----------------------------
2122 -- Set_Is_Not_Last_In_List --
2123 -----------------------------
2124
2125 procedure Set_Is_Not_Last_In_List
2126 (Node : Project_Node_Id;
2127 In_Tree : Project_Node_Tree_Ref)
2128 is
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;
2136
2137 -----------------
2138 -- Set_Kind_Of --
2139 -----------------
2140
2141 procedure Set_Kind_Of
2142 (Node : Project_Node_Id;
2143 In_Tree : Project_Node_Tree_Ref;
2144 To : Project_Node_Kind)
2145 is
2146 begin
2147 pragma Assert (Node /= Empty_Node);
2148 In_Tree.Project_Nodes.Table (Node).Kind := To;
2149 end Set_Kind_Of;
2150
2151 ---------------------
2152 -- Set_Location_Of --
2153 ---------------------
2154
2155 procedure Set_Location_Of
2156 (Node : Project_Node_Id;
2157 In_Tree : Project_Node_Tree_Ref;
2158 To : Source_Ptr)
2159 is
2160 begin
2161 pragma Assert (Node /= Empty_Node);
2162 In_Tree.Project_Nodes.Table (Node).Location := To;
2163 end Set_Location_Of;
2164
2165 -----------------------------
2166 -- Set_Extended_Project_Of --
2167 -----------------------------
2168
2169 procedure Set_Extended_Project_Of
2170 (Node : Project_Node_Id;
2171 In_Tree : Project_Node_Tree_Ref;
2172 To : Project_Node_Id)
2173 is
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;
2181
2182 ----------------------------------
2183 -- Set_Extended_Project_Path_Of --
2184 ----------------------------------
2185
2186 procedure Set_Extended_Project_Path_Of
2187 (Node : Project_Node_Id;
2188 In_Tree : Project_Node_Tree_Ref;
2189 To : Path_Name_Type)
2190 is
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;
2198
2199 ------------------------------
2200 -- Set_Extending_Project_Of --
2201 ------------------------------
2202
2203 procedure Set_Extending_Project_Of
2204 (Node : Project_Node_Id;
2205 In_Tree : Project_Node_Tree_Ref;
2206 To : Project_Node_Id)
2207 is
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;
2215
2216 -----------------
2217 -- Set_Name_Of --
2218 -----------------
2219
2220 procedure Set_Name_Of
2221 (Node : Project_Node_Id;
2222 In_Tree : Project_Node_Tree_Ref;
2223 To : Name_Id)
2224 is
2225 begin
2226 pragma Assert (Node /= Empty_Node);
2227 In_Tree.Project_Nodes.Table (Node).Name := To;
2228 end Set_Name_Of;
2229
2230 -------------------------------
2231 -- Set_Next_Declarative_Item --
2232 -------------------------------
2233
2234 procedure Set_Next_Declarative_Item
2235 (Node : Project_Node_Id;
2236 In_Tree : Project_Node_Tree_Ref;
2237 To : Project_Node_Id)
2238 is
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;
2246
2247 -----------------------
2248 -- Set_Next_End_Node --
2249 -----------------------
2250
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;
2256
2257 ---------------------------------
2258 -- Set_Next_Expression_In_List --
2259 ---------------------------------
2260
2261 procedure Set_Next_Expression_In_List
2262 (Node : Project_Node_Id;
2263 In_Tree : Project_Node_Tree_Ref;
2264 To : Project_Node_Id)
2265 is
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;
2273
2274 -----------------------------
2275 -- Set_Next_Literal_String --
2276 -----------------------------
2277
2278 procedure Set_Next_Literal_String
2279 (Node : Project_Node_Id;
2280 In_Tree : Project_Node_Tree_Ref;
2281 To : Project_Node_Id)
2282 is
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;
2290
2291 ---------------------------------
2292 -- Set_Next_Package_In_Project --
2293 ---------------------------------
2294
2295 procedure Set_Next_Package_In_Project
2296 (Node : Project_Node_Id;
2297 In_Tree : Project_Node_Tree_Ref;
2298 To : Project_Node_Id)
2299 is
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;
2307
2308 --------------------------
2309 -- Set_Next_String_Type --
2310 --------------------------
2311
2312 procedure Set_Next_String_Type
2313 (Node : Project_Node_Id;
2314 In_Tree : Project_Node_Tree_Ref;
2315 To : Project_Node_Id)
2316 is
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;
2325
2326 -------------------
2327 -- Set_Next_Term --
2328 -------------------
2329
2330 procedure Set_Next_Term
2331 (Node : Project_Node_Id;
2332 In_Tree : Project_Node_Tree_Ref;
2333 To : Project_Node_Id)
2334 is
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;
2342
2343 -----------------------
2344 -- Set_Next_Variable --
2345 -----------------------
2346
2347 procedure Set_Next_Variable
2348 (Node : Project_Node_Id;
2349 In_Tree : Project_Node_Tree_Ref;
2350 To : Project_Node_Id)
2351 is
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;
2363
2364 -----------------------------
2365 -- Set_Next_With_Clause_Of --
2366 -----------------------------
2367
2368 procedure Set_Next_With_Clause_Of
2369 (Node : Project_Node_Id;
2370 In_Tree : Project_Node_Tree_Ref;
2371 To : Project_Node_Id)
2372 is
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;
2380
2381 -----------------------
2382 -- Set_Package_Id_Of --
2383 -----------------------
2384
2385 procedure Set_Package_Id_Of
2386 (Node : Project_Node_Id;
2387 In_Tree : Project_Node_Tree_Ref;
2388 To : Package_Node_Id)
2389 is
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;
2397
2398 -------------------------
2399 -- Set_Package_Node_Of --
2400 -------------------------
2401
2402 procedure Set_Package_Node_Of
2403 (Node : Project_Node_Id;
2404 In_Tree : Project_Node_Tree_Ref;
2405 To : Project_Node_Id)
2406 is
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;
2416
2417 ----------------------
2418 -- Set_Path_Name_Of --
2419 ----------------------
2420
2421 procedure Set_Path_Name_Of
2422 (Node : Project_Node_Id;
2423 In_Tree : Project_Node_Tree_Ref;
2424 To : Path_Name_Type)
2425 is
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;
2435
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;
2443
2444 ----------------------------
2445 -- Set_Previous_Line_Node --
2446 ----------------------------
2447
2448 procedure Set_Previous_Line_Node (To : Project_Node_Id) is
2449 begin
2450 Previous_Line_Node := To;
2451 end Set_Previous_Line_Node;
2452
2453 --------------------------------
2454 -- Set_Project_Declaration_Of --
2455 --------------------------------
2456
2457 procedure Set_Project_Declaration_Of
2458 (Node : Project_Node_Id;
2459 In_Tree : Project_Node_Tree_Ref;
2460 To : Project_Node_Id)
2461 is
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;
2469
2470 -----------------------------------------------
2471 -- Set_Project_File_Includes_Unkept_Comments --
2472 -----------------------------------------------
2473
2474 procedure Set_Project_File_Includes_Unkept_Comments
2475 (Node : Project_Node_Id;
2476 In_Tree : Project_Node_Tree_Ref;
2477 To : Boolean)
2478 is
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;
2484
2485 -------------------------
2486 -- Set_Project_Node_Of --
2487 -------------------------
2488
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)
2494 is
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;
2505
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;
2512
2513 ---------------------------------------
2514 -- Set_Project_Of_Renamed_Package_Of --
2515 ---------------------------------------
2516
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)
2521 is
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;
2529
2530 -------------------------
2531 -- Set_Source_Index_Of --
2532 -------------------------
2533
2534 procedure Set_Source_Index_Of
2535 (Node : Project_Node_Id;
2536 In_Tree : Project_Node_Tree_Ref;
2537 To : Int)
2538 is
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;
2549
2550 ------------------------
2551 -- Set_String_Type_Of --
2552 ------------------------
2553
2554 procedure Set_String_Type_Of
2555 (Node : Project_Node_Id;
2556 In_Tree : Project_Node_Tree_Ref;
2557 To : Project_Node_Id)
2558 is
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);
2570
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;
2577
2578 -------------------------
2579 -- Set_String_Value_Of --
2580 -------------------------
2581
2582 procedure Set_String_Value_Of
2583 (Node : Project_Node_Id;
2584 In_Tree : Project_Node_Tree_Ref;
2585 To : Name_Id)
2586 is
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;
2598
2599 ---------------------
2600 -- Source_Index_Of --
2601 ---------------------
2602
2603 function Source_Index_Of
2604 (Node : Project_Node_Id;
2605 In_Tree : Project_Node_Tree_Ref) return Int
2606 is
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;
2617
2618 --------------------
2619 -- String_Type_Of --
2620 --------------------
2621
2622 function String_Type_Of
2623 (Node : Project_Node_Id;
2624 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
2625 is
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));
2635
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;
2642
2643 ---------------------
2644 -- String_Value_Of --
2645 ---------------------
2646
2647 function String_Value_Of
2648 (Node : Project_Node_Id;
2649 In_Tree : Project_Node_Tree_Ref) return Name_Id
2650 is
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;
2662
2663 --------------------
2664 -- Value_Is_Valid --
2665 --------------------
2666
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
2671 is
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));
2678
2679 declare
2680 Current_String : Project_Node_Id :=
2681 First_Literal_String
2682 (String_Type_Of (For_Typed_Variable, In_Tree),
2683 In_Tree);
2684
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;
2693
2694 return Current_String /= Empty_Node;
2695 end;
2696
2697 end Value_Is_Valid;
2698
2699 -------------------------------
2700 -- There_Are_Unkept_Comments --
2701 -------------------------------
2702
2703 function There_Are_Unkept_Comments return Boolean is
2704 begin
2705 return Unkept_Comments;
2706 end There_Are_Unkept_Comments;
2707
2708 end Prj.Tree;