File : 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-2014, 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 Osint; use Osint;
27 with Prj.Env; use Prj.Env;
28 with Prj.Err;
29
30 with Ada.Unchecked_Deallocation;
31
32 package body Prj.Tree is
33
34 Node_With_Comments : constant array (Project_Node_Kind) of Boolean :=
35 (N_Project => True,
36 N_With_Clause => True,
37 N_Project_Declaration => False,
38 N_Declarative_Item => False,
39 N_Package_Declaration => True,
40 N_String_Type_Declaration => True,
41 N_Literal_String => False,
42 N_Attribute_Declaration => True,
43 N_Typed_Variable_Declaration => True,
44 N_Variable_Declaration => True,
45 N_Expression => False,
46 N_Term => False,
47 N_Literal_String_List => False,
48 N_Variable_Reference => False,
49 N_External_Value => False,
50 N_Attribute_Reference => False,
51 N_Case_Construction => True,
52 N_Case_Item => True,
53 N_Comment_Zones => True,
54 N_Comment => True);
55 -- Indicates the kinds of node that may have associated comments
56
57 package Next_End_Nodes is new Table.Table
58 (Table_Component_Type => Project_Node_Id,
59 Table_Index_Type => Natural,
60 Table_Low_Bound => 1,
61 Table_Initial => 10,
62 Table_Increment => 100,
63 Table_Name => "Next_End_Nodes");
64 -- A stack of nodes to indicates to what node the next "end" is associated
65
66 use Tree_Private_Part;
67
68 End_Of_Line_Node : Project_Node_Id := Empty_Node;
69 -- The node an end of line comment may be associated with
70
71 Previous_Line_Node : Project_Node_Id := Empty_Node;
72 -- The node an immediately following comment may be associated with
73
74 Previous_End_Node : Project_Node_Id := Empty_Node;
75 -- The node comments immediately following an "end" line may be
76 -- associated with.
77
78 Unkept_Comments : Boolean := False;
79 -- Set to True when some comments may not be associated with any node
80
81 function Comment_Zones_Of
82 (Node : Project_Node_Id;
83 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
84 -- Returns the ID of the N_Comment_Zones node associated with node Node.
85 -- If there is not already an N_Comment_Zones node, create one and
86 -- associate it with node Node.
87
88 ------------------
89 -- Add_Comments --
90 ------------------
91
92 procedure Add_Comments
93 (To : Project_Node_Id;
94 In_Tree : Project_Node_Tree_Ref;
95 Where : Comment_Location) is
96 Zone : Project_Node_Id := Empty_Node;
97 Previous : Project_Node_Id := Empty_Node;
98
99 begin
100 pragma Assert
101 (Present (To)
102 and then In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
103
104 Zone := In_Tree.Project_Nodes.Table (To).Comments;
105
106 if No (Zone) then
107
108 -- Create new N_Comment_Zones node
109
110 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
111 In_Tree.Project_Nodes.Table
112 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
113 (Kind => N_Comment_Zones,
114 Qualifier => Unspecified,
115 Expr_Kind => Undefined,
116 Location => No_Location,
117 Directory => No_Path,
118 Variables => Empty_Node,
119 Packages => Empty_Node,
120 Pkg_Id => Empty_Package,
121 Name => No_Name,
122 Display_Name => No_Name,
123 Src_Index => 0,
124 Path_Name => No_Path,
125 Value => No_Name,
126 Default => Empty_Value,
127 Field1 => Empty_Node,
128 Field2 => Empty_Node,
129 Field3 => Empty_Node,
130 Field4 => Empty_Node,
131 Flag1 => False,
132 Flag2 => False,
133 Comments => Empty_Node);
134
135 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
136 In_Tree.Project_Nodes.Table (To).Comments := Zone;
137 end if;
138
139 if Where = End_Of_Line then
140 In_Tree.Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
141
142 else
143 -- Get each comments in the Comments table and link them to node To
144
145 for J in 1 .. Comments.Last loop
146
147 -- Create new N_Comment node
148
149 if (Where = After or else Where = After_End)
150 and then Token /= Tok_EOF
151 and then Comments.Table (J).Follows_Empty_Line
152 then
153 Comments.Table (1 .. Comments.Last - J + 1) :=
154 Comments.Table (J .. Comments.Last);
155 Comments.Set_Last (Comments.Last - J + 1);
156 return;
157 end if;
158
159 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
160 In_Tree.Project_Nodes.Table
161 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
162 (Kind => N_Comment,
163 Qualifier => Unspecified,
164 Expr_Kind => Undefined,
165 Flag1 => Comments.Table (J).Follows_Empty_Line,
166 Flag2 =>
167 Comments.Table (J).Is_Followed_By_Empty_Line,
168 Location => No_Location,
169 Directory => No_Path,
170 Variables => Empty_Node,
171 Packages => Empty_Node,
172 Pkg_Id => Empty_Package,
173 Name => No_Name,
174 Display_Name => No_Name,
175 Src_Index => 0,
176 Path_Name => No_Path,
177 Value => Comments.Table (J).Value,
178 Default => Empty_Value,
179 Field1 => Empty_Node,
180 Field2 => Empty_Node,
181 Field3 => Empty_Node,
182 Field4 => Empty_Node,
183 Comments => Empty_Node);
184
185 -- If this is the first comment, put it in the right field of
186 -- the node Zone.
187
188 if No (Previous) then
189 case Where is
190 when Before =>
191 In_Tree.Project_Nodes.Table (Zone).Field1 :=
192 Project_Node_Table.Last (In_Tree.Project_Nodes);
193
194 when After =>
195 In_Tree.Project_Nodes.Table (Zone).Field2 :=
196 Project_Node_Table.Last (In_Tree.Project_Nodes);
197
198 when Before_End =>
199 In_Tree.Project_Nodes.Table (Zone).Field3 :=
200 Project_Node_Table.Last (In_Tree.Project_Nodes);
201
202 when After_End =>
203 In_Tree.Project_Nodes.Table (Zone).Comments :=
204 Project_Node_Table.Last (In_Tree.Project_Nodes);
205
206 when End_Of_Line =>
207 null;
208 end case;
209
210 else
211 -- When it is not the first, link it to the previous one
212
213 In_Tree.Project_Nodes.Table (Previous).Comments :=
214 Project_Node_Table.Last (In_Tree.Project_Nodes);
215 end if;
216
217 -- This node becomes the previous one for the next comment, if
218 -- there is one.
219
220 Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
221 end loop;
222 end if;
223
224 -- Empty the Comments table, so that there is no risk to link the same
225 -- comments to another node.
226
227 Comments.Set_Last (0);
228 end Add_Comments;
229
230 --------------------------------
231 -- Associative_Array_Index_Of --
232 --------------------------------
233
234 function Associative_Array_Index_Of
235 (Node : Project_Node_Id;
236 In_Tree : Project_Node_Tree_Ref) return Name_Id
237 is
238 begin
239 pragma Assert
240 (Present (Node)
241 and then
242 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
243 or else
244 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
245 return In_Tree.Project_Nodes.Table (Node).Value;
246 end Associative_Array_Index_Of;
247
248 ----------------------------
249 -- Associative_Package_Of --
250 ----------------------------
251
252 function Associative_Package_Of
253 (Node : Project_Node_Id;
254 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
255 is
256 begin
257 pragma Assert
258 (Present (Node)
259 and then
260 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
261 return In_Tree.Project_Nodes.Table (Node).Field3;
262 end Associative_Package_Of;
263
264 ----------------------------
265 -- Associative_Project_Of --
266 ----------------------------
267
268 function Associative_Project_Of
269 (Node : Project_Node_Id;
270 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
271 is
272 begin
273 pragma Assert
274 (Present (Node)
275 and then
276 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
277 return In_Tree.Project_Nodes.Table (Node).Field2;
278 end Associative_Project_Of;
279
280 ----------------------
281 -- Case_Insensitive --
282 ----------------------
283
284 function Case_Insensitive
285 (Node : Project_Node_Id;
286 In_Tree : Project_Node_Tree_Ref) return Boolean
287 is
288 begin
289 pragma Assert
290 (Present (Node)
291 and then
292 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
293 or else
294 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
295 return In_Tree.Project_Nodes.Table (Node).Flag1;
296 end Case_Insensitive;
297
298 --------------------------------
299 -- Case_Variable_Reference_Of --
300 --------------------------------
301
302 function Case_Variable_Reference_Of
303 (Node : Project_Node_Id;
304 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
305 is
306 begin
307 pragma Assert
308 (Present (Node)
309 and then
310 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
311 return In_Tree.Project_Nodes.Table (Node).Field1;
312 end Case_Variable_Reference_Of;
313
314 ----------------------
315 -- Comment_Zones_Of --
316 ----------------------
317
318 function Comment_Zones_Of
319 (Node : Project_Node_Id;
320 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
321 is
322 Zone : Project_Node_Id;
323
324 begin
325 pragma Assert (Present (Node));
326 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
327
328 -- If there is not already an N_Comment_Zones associated, create a new
329 -- one and associate it with node Node.
330
331 if No (Zone) then
332 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
333 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
334 In_Tree.Project_Nodes.Table (Zone) :=
335 (Kind => N_Comment_Zones,
336 Qualifier => Unspecified,
337 Location => No_Location,
338 Directory => No_Path,
339 Expr_Kind => Undefined,
340 Variables => Empty_Node,
341 Packages => Empty_Node,
342 Pkg_Id => Empty_Package,
343 Name => No_Name,
344 Display_Name => No_Name,
345 Src_Index => 0,
346 Path_Name => No_Path,
347 Value => No_Name,
348 Default => Empty_Value,
349 Field1 => Empty_Node,
350 Field2 => Empty_Node,
351 Field3 => Empty_Node,
352 Field4 => Empty_Node,
353 Flag1 => False,
354 Flag2 => False,
355 Comments => Empty_Node);
356 In_Tree.Project_Nodes.Table (Node).Comments := Zone;
357 end if;
358
359 return Zone;
360 end Comment_Zones_Of;
361
362 -----------------------
363 -- Current_Item_Node --
364 -----------------------
365
366 function Current_Item_Node
367 (Node : Project_Node_Id;
368 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
369 is
370 begin
371 pragma Assert
372 (Present (Node)
373 and then
374 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
375 return In_Tree.Project_Nodes.Table (Node).Field1;
376 end Current_Item_Node;
377
378 ------------------
379 -- Current_Term --
380 ------------------
381
382 function Current_Term
383 (Node : Project_Node_Id;
384 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
385 is
386 begin
387 pragma Assert
388 (Present (Node)
389 and then
390 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
391 return In_Tree.Project_Nodes.Table (Node).Field1;
392 end Current_Term;
393
394 ----------------
395 -- Default_Of --
396 ----------------
397
398 function Default_Of
399 (Node : Project_Node_Id;
400 In_Tree : Project_Node_Tree_Ref) return Attribute_Default_Value
401 is
402 begin
403 pragma Assert
404 (Present (Node)
405 and then
406 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference);
407 return In_Tree.Project_Nodes.Table (Node).Default;
408 end Default_Of;
409
410 --------------------------
411 -- Default_Project_Node --
412 --------------------------
413
414 function Default_Project_Node
415 (In_Tree : Project_Node_Tree_Ref;
416 Of_Kind : Project_Node_Kind;
417 And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id
418 is
419 Result : Project_Node_Id;
420 Zone : Project_Node_Id;
421 Previous : Project_Node_Id;
422
423 begin
424 -- Create new node with specified kind and expression kind
425
426 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
427 In_Tree.Project_Nodes.Table
428 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
429 (Kind => Of_Kind,
430 Qualifier => Unspecified,
431 Location => No_Location,
432 Directory => No_Path,
433 Expr_Kind => And_Expr_Kind,
434 Variables => Empty_Node,
435 Packages => Empty_Node,
436 Pkg_Id => Empty_Package,
437 Name => No_Name,
438 Display_Name => No_Name,
439 Src_Index => 0,
440 Path_Name => No_Path,
441 Value => No_Name,
442 Default => Empty_Value,
443 Field1 => Empty_Node,
444 Field2 => Empty_Node,
445 Field3 => Empty_Node,
446 Field4 => Empty_Node,
447 Flag1 => False,
448 Flag2 => False,
449 Comments => Empty_Node);
450
451 -- Save the new node for the returned value
452
453 Result := Project_Node_Table.Last (In_Tree.Project_Nodes);
454
455 if Comments.Last > 0 then
456
457 -- If this is not a node with comments, then set the flag
458
459 if not Node_With_Comments (Of_Kind) then
460 Unkept_Comments := True;
461
462 elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then
463
464 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
465 In_Tree.Project_Nodes.Table
466 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
467 (Kind => N_Comment_Zones,
468 Qualifier => Unspecified,
469 Expr_Kind => Undefined,
470 Location => No_Location,
471 Directory => No_Path,
472 Variables => Empty_Node,
473 Packages => Empty_Node,
474 Pkg_Id => Empty_Package,
475 Name => No_Name,
476 Display_Name => No_Name,
477 Src_Index => 0,
478 Path_Name => No_Path,
479 Value => No_Name,
480 Default => Empty_Value,
481 Field1 => Empty_Node,
482 Field2 => Empty_Node,
483 Field3 => Empty_Node,
484 Field4 => Empty_Node,
485 Flag1 => False,
486 Flag2 => False,
487 Comments => Empty_Node);
488
489 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
490 In_Tree.Project_Nodes.Table (Result).Comments := Zone;
491 Previous := Empty_Node;
492
493 for J in 1 .. Comments.Last loop
494
495 -- Create a new N_Comment node
496
497 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
498 In_Tree.Project_Nodes.Table
499 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
500 (Kind => N_Comment,
501 Qualifier => Unspecified,
502 Expr_Kind => Undefined,
503 Flag1 => Comments.Table (J).Follows_Empty_Line,
504 Flag2 =>
505 Comments.Table (J).Is_Followed_By_Empty_Line,
506 Location => No_Location,
507 Directory => No_Path,
508 Variables => Empty_Node,
509 Packages => Empty_Node,
510 Pkg_Id => Empty_Package,
511 Name => No_Name,
512 Display_Name => No_Name,
513 Src_Index => 0,
514 Path_Name => No_Path,
515 Value => Comments.Table (J).Value,
516 Default => Empty_Value,
517 Field1 => Empty_Node,
518 Field2 => Empty_Node,
519 Field3 => Empty_Node,
520 Field4 => Empty_Node,
521 Comments => Empty_Node);
522
523 -- Link it to the N_Comment_Zones node, if it is the first,
524 -- otherwise to the previous one.
525
526 if No (Previous) then
527 In_Tree.Project_Nodes.Table (Zone).Field1 :=
528 Project_Node_Table.Last (In_Tree.Project_Nodes);
529
530 else
531 In_Tree.Project_Nodes.Table (Previous).Comments :=
532 Project_Node_Table.Last (In_Tree.Project_Nodes);
533 end if;
534
535 -- This new node will be the previous one for the next
536 -- N_Comment node, if there is one.
537
538 Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
539 end loop;
540
541 -- Empty the Comments table after all comments have been processed
542
543 Comments.Set_Last (0);
544 end if;
545 end if;
546
547 return Result;
548 end Default_Project_Node;
549
550 ------------------
551 -- Directory_Of --
552 ------------------
553
554 function Directory_Of
555 (Node : Project_Node_Id;
556 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
557 is
558 begin
559 pragma Assert
560 (Present (Node)
561 and then
562 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
563 return In_Tree.Project_Nodes.Table (Node).Directory;
564 end Directory_Of;
565
566 -------------------------
567 -- End_Of_Line_Comment --
568 -------------------------
569
570 function End_Of_Line_Comment
571 (Node : Project_Node_Id;
572 In_Tree : Project_Node_Tree_Ref) return Name_Id
573 is
574 Zone : Project_Node_Id := Empty_Node;
575
576 begin
577 pragma Assert (Present (Node));
578 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
579
580 if No (Zone) then
581 return No_Name;
582 else
583 return In_Tree.Project_Nodes.Table (Zone).Value;
584 end if;
585 end End_Of_Line_Comment;
586
587 ------------------------
588 -- Expression_Kind_Of --
589 ------------------------
590
591 function Expression_Kind_Of
592 (Node : Project_Node_Id;
593 In_Tree : Project_Node_Tree_Ref) return Variable_Kind
594 is
595 begin
596 pragma Assert
597 (Present (Node)
598 and then -- should use Nkind_In here ??? why not???
599 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
600 or else
601 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
602 or else
603 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
604 or else
605 In_Tree.Project_Nodes.Table (Node).Kind =
606 N_Typed_Variable_Declaration
607 or else
608 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
609 or else
610 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
611 or else
612 In_Tree.Project_Nodes.Table (Node).Kind = N_Term
613 or else
614 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
615 or else
616 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference
617 or else
618 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value));
619 return In_Tree.Project_Nodes.Table (Node).Expr_Kind;
620 end Expression_Kind_Of;
621
622 -------------------
623 -- Expression_Of --
624 -------------------
625
626 function Expression_Of
627 (Node : Project_Node_Id;
628 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
629 is
630 begin
631 pragma Assert
632 (Present (Node)
633 and then
634 (In_Tree.Project_Nodes.Table (Node).Kind =
635 N_Attribute_Declaration
636 or else
637 In_Tree.Project_Nodes.Table (Node).Kind =
638 N_Typed_Variable_Declaration
639 or else
640 In_Tree.Project_Nodes.Table (Node).Kind =
641 N_Variable_Declaration));
642
643 return In_Tree.Project_Nodes.Table (Node).Field1;
644 end Expression_Of;
645
646 -------------------------
647 -- Extended_Project_Of --
648 -------------------------
649
650 function Extended_Project_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 (Present (Node)
657 and then
658 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
659 return In_Tree.Project_Nodes.Table (Node).Field2;
660 end Extended_Project_Of;
661
662 ------------------------------
663 -- Extended_Project_Path_Of --
664 ------------------------------
665
666 function Extended_Project_Path_Of
667 (Node : Project_Node_Id;
668 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
669 is
670 begin
671 pragma Assert
672 (Present (Node)
673 and then
674 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
675 return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value);
676 end Extended_Project_Path_Of;
677
678 --------------------------
679 -- Extending_Project_Of --
680 --------------------------
681 function Extending_Project_Of
682 (Node : Project_Node_Id;
683 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
684 is
685 begin
686 pragma Assert
687 (Present (Node)
688 and then
689 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
690 return In_Tree.Project_Nodes.Table (Node).Field3;
691 end Extending_Project_Of;
692
693 ---------------------------
694 -- External_Reference_Of --
695 ---------------------------
696
697 function External_Reference_Of
698 (Node : Project_Node_Id;
699 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
700 is
701 begin
702 pragma Assert
703 (Present (Node)
704 and then
705 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
706 return In_Tree.Project_Nodes.Table (Node).Field1;
707 end External_Reference_Of;
708
709 -------------------------
710 -- External_Default_Of --
711 -------------------------
712
713 function External_Default_Of
714 (Node : Project_Node_Id;
715 In_Tree : Project_Node_Tree_Ref)
716 return Project_Node_Id
717 is
718 begin
719 pragma Assert
720 (Present (Node)
721 and then
722 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
723 return In_Tree.Project_Nodes.Table (Node).Field2;
724 end External_Default_Of;
725
726 ------------------------
727 -- First_Case_Item_Of --
728 ------------------------
729
730 function First_Case_Item_Of
731 (Node : Project_Node_Id;
732 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
733 is
734 begin
735 pragma Assert
736 (Present (Node)
737 and then
738 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
739 return In_Tree.Project_Nodes.Table (Node).Field2;
740 end First_Case_Item_Of;
741
742 ---------------------
743 -- First_Choice_Of --
744 ---------------------
745
746 function First_Choice_Of
747 (Node : Project_Node_Id;
748 In_Tree : Project_Node_Tree_Ref)
749 return Project_Node_Id
750 is
751 begin
752 pragma Assert
753 (Present (Node)
754 and then
755 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
756 return In_Tree.Project_Nodes.Table (Node).Field1;
757 end First_Choice_Of;
758
759 -------------------------
760 -- First_Comment_After --
761 -------------------------
762
763 function First_Comment_After
764 (Node : Project_Node_Id;
765 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
766 is
767 Zone : Project_Node_Id := Empty_Node;
768 begin
769 pragma Assert (Present (Node));
770 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
771
772 if No (Zone) then
773 return Empty_Node;
774
775 else
776 return In_Tree.Project_Nodes.Table (Zone).Field2;
777 end if;
778 end First_Comment_After;
779
780 -----------------------------
781 -- First_Comment_After_End --
782 -----------------------------
783
784 function First_Comment_After_End
785 (Node : Project_Node_Id;
786 In_Tree : Project_Node_Tree_Ref)
787 return Project_Node_Id
788 is
789 Zone : Project_Node_Id := Empty_Node;
790
791 begin
792 pragma Assert (Present (Node));
793 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
794
795 if No (Zone) then
796 return Empty_Node;
797
798 else
799 return In_Tree.Project_Nodes.Table (Zone).Comments;
800 end if;
801 end First_Comment_After_End;
802
803 --------------------------
804 -- First_Comment_Before --
805 --------------------------
806
807 function First_Comment_Before
808 (Node : Project_Node_Id;
809 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
810 is
811 Zone : Project_Node_Id := Empty_Node;
812
813 begin
814 pragma Assert (Present (Node));
815 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
816
817 if No (Zone) then
818 return Empty_Node;
819
820 else
821 return In_Tree.Project_Nodes.Table (Zone).Field1;
822 end if;
823 end First_Comment_Before;
824
825 ------------------------------
826 -- First_Comment_Before_End --
827 ------------------------------
828
829 function First_Comment_Before_End
830 (Node : Project_Node_Id;
831 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
832 is
833 Zone : Project_Node_Id := Empty_Node;
834
835 begin
836 pragma Assert (Present (Node));
837 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
838
839 if No (Zone) then
840 return Empty_Node;
841
842 else
843 return In_Tree.Project_Nodes.Table (Zone).Field3;
844 end if;
845 end First_Comment_Before_End;
846
847 -------------------------------
848 -- First_Declarative_Item_Of --
849 -------------------------------
850
851 function First_Declarative_Item_Of
852 (Node : Project_Node_Id;
853 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
854 is
855 begin
856 pragma Assert
857 (Present (Node)
858 and then
859 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
860 or else
861 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
862 or else
863 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
864
865 if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
866 return In_Tree.Project_Nodes.Table (Node).Field1;
867 else
868 return In_Tree.Project_Nodes.Table (Node).Field2;
869 end if;
870 end First_Declarative_Item_Of;
871
872 ------------------------------
873 -- First_Expression_In_List --
874 ------------------------------
875
876 function First_Expression_In_List
877 (Node : Project_Node_Id;
878 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
879 is
880 begin
881 pragma Assert
882 (Present (Node)
883 and then
884 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
885 return In_Tree.Project_Nodes.Table (Node).Field1;
886 end First_Expression_In_List;
887
888 --------------------------
889 -- First_Literal_String --
890 --------------------------
891
892 function First_Literal_String
893 (Node : Project_Node_Id;
894 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
895 is
896 begin
897 pragma Assert
898 (Present (Node)
899 and then
900 In_Tree.Project_Nodes.Table (Node).Kind =
901 N_String_Type_Declaration);
902 return In_Tree.Project_Nodes.Table (Node).Field1;
903 end First_Literal_String;
904
905 ----------------------
906 -- First_Package_Of --
907 ----------------------
908
909 function First_Package_Of
910 (Node : Project_Node_Id;
911 In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id
912 is
913 begin
914 pragma Assert
915 (Present (Node)
916 and then
917 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
918 return In_Tree.Project_Nodes.Table (Node).Packages;
919 end First_Package_Of;
920
921 --------------------------
922 -- First_String_Type_Of --
923 --------------------------
924
925 function First_String_Type_Of
926 (Node : Project_Node_Id;
927 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
928 is
929 begin
930 pragma Assert
931 (Present (Node)
932 and then
933 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
934 return In_Tree.Project_Nodes.Table (Node).Field3;
935 end First_String_Type_Of;
936
937 ----------------
938 -- First_Term --
939 ----------------
940
941 function First_Term
942 (Node : Project_Node_Id;
943 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
944 is
945 begin
946 pragma Assert
947 (Present (Node)
948 and then
949 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
950 return In_Tree.Project_Nodes.Table (Node).Field1;
951 end First_Term;
952
953 -----------------------
954 -- First_Variable_Of --
955 -----------------------
956
957 function First_Variable_Of
958 (Node : Project_Node_Id;
959 In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id
960 is
961 begin
962 pragma Assert
963 (Present (Node)
964 and then
965 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
966 or else
967 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
968
969 return In_Tree.Project_Nodes.Table (Node).Variables;
970 end First_Variable_Of;
971
972 --------------------------
973 -- First_With_Clause_Of --
974 --------------------------
975
976 function First_With_Clause_Of
977 (Node : Project_Node_Id;
978 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
979 is
980 begin
981 pragma Assert
982 (Present (Node)
983 and then
984 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
985 return In_Tree.Project_Nodes.Table (Node).Field1;
986 end First_With_Clause_Of;
987
988 ------------------------
989 -- Follows_Empty_Line --
990 ------------------------
991
992 function Follows_Empty_Line
993 (Node : Project_Node_Id;
994 In_Tree : Project_Node_Tree_Ref) return Boolean
995 is
996 begin
997 pragma Assert
998 (Present (Node)
999 and then
1000 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1001 return In_Tree.Project_Nodes.Table (Node).Flag1;
1002 end Follows_Empty_Line;
1003
1004 ----------
1005 -- Hash --
1006 ----------
1007
1008 function Hash (N : Project_Node_Id) return Header_Num is
1009 begin
1010 return Header_Num (N mod Project_Node_Id (Header_Num'Last));
1011 end Hash;
1012
1013 ----------------
1014 -- Initialize --
1015 ----------------
1016
1017 procedure Initialize (Tree : Project_Node_Tree_Ref) is
1018 begin
1019 Project_Node_Table.Init (Tree.Project_Nodes);
1020 Projects_Htable.Reset (Tree.Projects_HT);
1021 end Initialize;
1022
1023 --------------------
1024 -- Override_Flags --
1025 --------------------
1026
1027 procedure Override_Flags
1028 (Self : in out Environment;
1029 Flags : Prj.Processing_Flags)
1030 is
1031 begin
1032 Self.Flags := Flags;
1033 end Override_Flags;
1034
1035 ----------------
1036 -- Initialize --
1037 ----------------
1038
1039 procedure Initialize
1040 (Self : out Environment;
1041 Flags : Processing_Flags)
1042 is
1043 begin
1044 -- Do not reset the external references, in case we are reloading a
1045 -- project, since we want to preserve the current environment. But we
1046 -- still need to ensure that the external references are properly
1047 -- initialized.
1048
1049 Prj.Ext.Initialize (Self.External);
1050
1051 Self.Flags := Flags;
1052 end Initialize;
1053
1054 -------------------------
1055 -- Initialize_And_Copy --
1056 -------------------------
1057
1058 procedure Initialize_And_Copy
1059 (Self : out Environment;
1060 Copy_From : Environment)
1061 is
1062 begin
1063 Self.Flags := Copy_From.Flags;
1064 Prj.Ext.Initialize (Self.External, Copy_From => Copy_From.External);
1065 Prj.Env.Copy (From => Copy_From.Project_Path, To => Self.Project_Path);
1066 end Initialize_And_Copy;
1067
1068 ----------
1069 -- Free --
1070 ----------
1071
1072 procedure Free (Self : in out Environment) is
1073 begin
1074 Prj.Ext.Free (Self.External);
1075 Free (Self.Project_Path);
1076 end Free;
1077
1078 ----------
1079 -- Free --
1080 ----------
1081
1082 procedure Free (Proj : in out Project_Node_Tree_Ref) is
1083 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1084 (Project_Node_Tree_Data, Project_Node_Tree_Ref);
1085 begin
1086 if Proj /= null then
1087 Project_Node_Table.Free (Proj.Project_Nodes);
1088 Projects_Htable.Reset (Proj.Projects_HT);
1089 Unchecked_Free (Proj);
1090 end if;
1091 end Free;
1092
1093 -------------------------------
1094 -- Is_Followed_By_Empty_Line --
1095 -------------------------------
1096
1097 function Is_Followed_By_Empty_Line
1098 (Node : Project_Node_Id;
1099 In_Tree : Project_Node_Tree_Ref) return Boolean
1100 is
1101 begin
1102 pragma Assert
1103 (Present (Node)
1104 and then
1105 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1106 return In_Tree.Project_Nodes.Table (Node).Flag2;
1107 end Is_Followed_By_Empty_Line;
1108
1109 ----------------------
1110 -- Is_Extending_All --
1111 ----------------------
1112
1113 function Is_Extending_All
1114 (Node : Project_Node_Id;
1115 In_Tree : Project_Node_Tree_Ref) return Boolean
1116 is
1117 begin
1118 pragma Assert
1119 (Present (Node)
1120 and then
1121 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1122 or else
1123 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1124 return In_Tree.Project_Nodes.Table (Node).Flag2;
1125 end Is_Extending_All;
1126
1127 -------------------------
1128 -- Is_Not_Last_In_List --
1129 -------------------------
1130
1131 function Is_Not_Last_In_List
1132 (Node : Project_Node_Id;
1133 In_Tree : Project_Node_Tree_Ref) return Boolean
1134 is
1135 begin
1136 pragma Assert
1137 (Present (Node)
1138 and then
1139 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1140 return In_Tree.Project_Nodes.Table (Node).Flag1;
1141 end Is_Not_Last_In_List;
1142
1143 -------------------------------------
1144 -- Imported_Or_Extended_Project_Of --
1145 -------------------------------------
1146
1147 function Imported_Or_Extended_Project_Of
1148 (Project : Project_Node_Id;
1149 In_Tree : Project_Node_Tree_Ref;
1150 With_Name : Name_Id) return Project_Node_Id
1151 is
1152 With_Clause : Project_Node_Id;
1153 Result : Project_Node_Id := Empty_Node;
1154 Decl : Project_Node_Id;
1155
1156 begin
1157 -- First check all the imported projects
1158
1159 With_Clause := First_With_Clause_Of (Project, In_Tree);
1160 while Present (With_Clause) loop
1161
1162 -- Only non limited imported project may be used as prefix of
1163 -- variables or attributes.
1164
1165 Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree);
1166 while Present (Result) loop
1167 if Name_Of (Result, In_Tree) = With_Name then
1168 return Result;
1169 end if;
1170
1171 Decl := Project_Declaration_Of (Result, In_Tree);
1172
1173 -- Do not try to check for an extended project, if the project
1174 -- does not have yet a project declaration.
1175
1176 exit when Decl = Empty_Node;
1177
1178 Result := Extended_Project_Of (Decl, In_Tree);
1179 end loop;
1180
1181 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1182 end loop;
1183
1184 -- If it is not an imported project, it might be an extended project
1185
1186 if No (With_Clause) then
1187 Result := Project;
1188 loop
1189 Result :=
1190 Extended_Project_Of
1191 (Project_Declaration_Of (Result, In_Tree), In_Tree);
1192
1193 exit when No (Result)
1194 or else Name_Of (Result, In_Tree) = With_Name;
1195 end loop;
1196 end if;
1197
1198 return Result;
1199 end Imported_Or_Extended_Project_Of;
1200
1201 -------------
1202 -- Kind_Of --
1203 -------------
1204
1205 function Kind_Of
1206 (Node : Project_Node_Id;
1207 In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind
1208 is
1209 begin
1210 pragma Assert (Present (Node));
1211 return In_Tree.Project_Nodes.Table (Node).Kind;
1212 end Kind_Of;
1213
1214 -----------------
1215 -- Location_Of --
1216 -----------------
1217
1218 function Location_Of
1219 (Node : Project_Node_Id;
1220 In_Tree : Project_Node_Tree_Ref) return Source_Ptr
1221 is
1222 begin
1223 pragma Assert (Present (Node));
1224 return In_Tree.Project_Nodes.Table (Node).Location;
1225 end Location_Of;
1226
1227 -------------
1228 -- Name_Of --
1229 -------------
1230
1231 function Name_Of
1232 (Node : Project_Node_Id;
1233 In_Tree : Project_Node_Tree_Ref) return Name_Id
1234 is
1235 begin
1236 pragma Assert (Present (Node));
1237 return In_Tree.Project_Nodes.Table (Node).Name;
1238 end Name_Of;
1239
1240 ---------------------
1241 -- Display_Name_Of --
1242 ---------------------
1243
1244 function Display_Name_Of
1245 (Node : Project_Node_Id;
1246 In_Tree : Project_Node_Tree_Ref) return Name_Id
1247 is
1248 begin
1249 pragma Assert
1250 (Present (Node)
1251 and then
1252 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1253 return In_Tree.Project_Nodes.Table (Node).Display_Name;
1254 end Display_Name_Of;
1255
1256 --------------------
1257 -- Next_Case_Item --
1258 --------------------
1259
1260 function Next_Case_Item
1261 (Node : Project_Node_Id;
1262 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1263 is
1264 begin
1265 pragma Assert
1266 (Present (Node)
1267 and then
1268 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1269 return In_Tree.Project_Nodes.Table (Node).Field3;
1270 end Next_Case_Item;
1271
1272 ------------------
1273 -- Next_Comment --
1274 ------------------
1275
1276 function Next_Comment
1277 (Node : Project_Node_Id;
1278 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1279 is
1280 begin
1281 pragma Assert
1282 (Present (Node)
1283 and then
1284 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1285 return In_Tree.Project_Nodes.Table (Node).Comments;
1286 end Next_Comment;
1287
1288 ---------------------------
1289 -- Next_Declarative_Item --
1290 ---------------------------
1291
1292 function Next_Declarative_Item
1293 (Node : Project_Node_Id;
1294 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1295 is
1296 begin
1297 pragma Assert
1298 (Present (Node)
1299 and then
1300 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1301 return In_Tree.Project_Nodes.Table (Node).Field2;
1302 end Next_Declarative_Item;
1303
1304 -----------------------------
1305 -- Next_Expression_In_List --
1306 -----------------------------
1307
1308 function Next_Expression_In_List
1309 (Node : Project_Node_Id;
1310 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1311 is
1312 begin
1313 pragma Assert
1314 (Present (Node)
1315 and then
1316 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
1317 return In_Tree.Project_Nodes.Table (Node).Field2;
1318 end Next_Expression_In_List;
1319
1320 -------------------------
1321 -- Next_Literal_String --
1322 -------------------------
1323
1324 function Next_Literal_String
1325 (Node : Project_Node_Id;
1326 In_Tree : Project_Node_Tree_Ref)
1327 return Project_Node_Id
1328 is
1329 begin
1330 pragma Assert
1331 (Present (Node)
1332 and then
1333 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
1334 return In_Tree.Project_Nodes.Table (Node).Field1;
1335 end Next_Literal_String;
1336
1337 -----------------------------
1338 -- Next_Package_In_Project --
1339 -----------------------------
1340
1341 function Next_Package_In_Project
1342 (Node : Project_Node_Id;
1343 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1344 is
1345 begin
1346 pragma Assert
1347 (Present (Node)
1348 and then
1349 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1350 return In_Tree.Project_Nodes.Table (Node).Field3;
1351 end Next_Package_In_Project;
1352
1353 ----------------------
1354 -- Next_String_Type --
1355 ----------------------
1356
1357 function Next_String_Type
1358 (Node : Project_Node_Id;
1359 In_Tree : Project_Node_Tree_Ref)
1360 return Project_Node_Id
1361 is
1362 begin
1363 pragma Assert
1364 (Present (Node)
1365 and then
1366 In_Tree.Project_Nodes.Table (Node).Kind =
1367 N_String_Type_Declaration);
1368 return In_Tree.Project_Nodes.Table (Node).Field2;
1369 end Next_String_Type;
1370
1371 ---------------
1372 -- Next_Term --
1373 ---------------
1374
1375 function Next_Term
1376 (Node : Project_Node_Id;
1377 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1378 is
1379 begin
1380 pragma Assert
1381 (Present (Node)
1382 and then In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1383 return In_Tree.Project_Nodes.Table (Node).Field2;
1384 end Next_Term;
1385
1386 -------------------
1387 -- Next_Variable --
1388 -------------------
1389
1390 function Next_Variable
1391 (Node : Project_Node_Id;
1392 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1393 is
1394 begin
1395 pragma Assert
1396 (Present (Node)
1397 and then
1398 (In_Tree.Project_Nodes.Table (Node).Kind =
1399 N_Typed_Variable_Declaration
1400 or else
1401 In_Tree.Project_Nodes.Table (Node).Kind =
1402 N_Variable_Declaration));
1403
1404 return In_Tree.Project_Nodes.Table (Node).Field3;
1405 end Next_Variable;
1406
1407 -------------------------
1408 -- Next_With_Clause_Of --
1409 -------------------------
1410
1411 function Next_With_Clause_Of
1412 (Node : Project_Node_Id;
1413 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1414 is
1415 begin
1416 pragma Assert
1417 (Present (Node)
1418 and then
1419 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1420 return In_Tree.Project_Nodes.Table (Node).Field2;
1421 end Next_With_Clause_Of;
1422
1423 --------
1424 -- No --
1425 --------
1426
1427 function No (Node : Project_Node_Id) return Boolean is
1428 begin
1429 return Node = Empty_Node;
1430 end No;
1431
1432 ---------------------------------
1433 -- Non_Limited_Project_Node_Of --
1434 ---------------------------------
1435
1436 function Non_Limited_Project_Node_Of
1437 (Node : Project_Node_Id;
1438 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1439 is
1440 begin
1441 pragma Assert
1442 (Present (Node)
1443 and then
1444 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1445 return In_Tree.Project_Nodes.Table (Node).Field3;
1446 end Non_Limited_Project_Node_Of;
1447
1448 -------------------
1449 -- Package_Id_Of --
1450 -------------------
1451
1452 function Package_Id_Of
1453 (Node : Project_Node_Id;
1454 In_Tree : Project_Node_Tree_Ref) return Package_Node_Id
1455 is
1456 begin
1457 pragma Assert
1458 (Present (Node)
1459 and then
1460 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1461 return In_Tree.Project_Nodes.Table (Node).Pkg_Id;
1462 end Package_Id_Of;
1463
1464 ---------------------
1465 -- Package_Node_Of --
1466 ---------------------
1467
1468 function Package_Node_Of
1469 (Node : Project_Node_Id;
1470 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1471 is
1472 begin
1473 pragma Assert
1474 (Present (Node)
1475 and then
1476 (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1477 or else
1478 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1479 return In_Tree.Project_Nodes.Table (Node).Field2;
1480 end Package_Node_Of;
1481
1482 ------------------
1483 -- Path_Name_Of --
1484 ------------------
1485
1486 function Path_Name_Of
1487 (Node : Project_Node_Id;
1488 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
1489 is
1490 begin
1491 pragma Assert
1492 (Present (Node)
1493 and then
1494 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1495 or else
1496 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1497 return In_Tree.Project_Nodes.Table (Node).Path_Name;
1498 end Path_Name_Of;
1499
1500 -------------
1501 -- Present --
1502 -------------
1503
1504 function Present (Node : Project_Node_Id) return Boolean is
1505 begin
1506 return Node /= Empty_Node;
1507 end Present;
1508
1509 ----------------------------
1510 -- Project_Declaration_Of --
1511 ----------------------------
1512
1513 function Project_Declaration_Of
1514 (Node : Project_Node_Id;
1515 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1516 is
1517 begin
1518 pragma Assert
1519 (Present (Node)
1520 and then
1521 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1522 return In_Tree.Project_Nodes.Table (Node).Field2;
1523 end Project_Declaration_Of;
1524
1525 --------------------------
1526 -- Project_Qualifier_Of --
1527 --------------------------
1528
1529 function Project_Qualifier_Of
1530 (Node : Project_Node_Id;
1531 In_Tree : Project_Node_Tree_Ref) return Project_Qualifier
1532 is
1533 begin
1534 pragma Assert
1535 (Present (Node)
1536 and then
1537 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1538 return In_Tree.Project_Nodes.Table (Node).Qualifier;
1539 end Project_Qualifier_Of;
1540
1541 -----------------------
1542 -- Parent_Project_Of --
1543 -----------------------
1544
1545 function Parent_Project_Of
1546 (Node : Project_Node_Id;
1547 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1548 is
1549 begin
1550 pragma Assert
1551 (Present (Node)
1552 and then
1553 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1554 return In_Tree.Project_Nodes.Table (Node).Field4;
1555 end Parent_Project_Of;
1556
1557 -------------------------------------------
1558 -- Project_File_Includes_Unkept_Comments --
1559 -------------------------------------------
1560
1561 function Project_File_Includes_Unkept_Comments
1562 (Node : Project_Node_Id;
1563 In_Tree : Project_Node_Tree_Ref) return Boolean
1564 is
1565 Declaration : constant Project_Node_Id :=
1566 Project_Declaration_Of (Node, In_Tree);
1567 begin
1568 return In_Tree.Project_Nodes.Table (Declaration).Flag1;
1569 end Project_File_Includes_Unkept_Comments;
1570
1571 ---------------------
1572 -- Project_Node_Of --
1573 ---------------------
1574
1575 function Project_Node_Of
1576 (Node : Project_Node_Id;
1577 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1578 is
1579 begin
1580 pragma Assert
1581 (Present (Node)
1582 and then
1583 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
1584 or else
1585 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1586 or else
1587 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1588 return In_Tree.Project_Nodes.Table (Node).Field1;
1589 end Project_Node_Of;
1590
1591 -----------------------------------
1592 -- Project_Of_Renamed_Package_Of --
1593 -----------------------------------
1594
1595 function Project_Of_Renamed_Package_Of
1596 (Node : Project_Node_Id;
1597 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1598 is
1599 begin
1600 pragma Assert
1601 (Present (Node)
1602 and then
1603 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1604 return In_Tree.Project_Nodes.Table (Node).Field1;
1605 end Project_Of_Renamed_Package_Of;
1606
1607 --------------------------
1608 -- Remove_Next_End_Node --
1609 --------------------------
1610
1611 procedure Remove_Next_End_Node is
1612 begin
1613 Next_End_Nodes.Decrement_Last;
1614 end Remove_Next_End_Node;
1615
1616 -----------------
1617 -- Reset_State --
1618 -----------------
1619
1620 procedure Reset_State is
1621 begin
1622 End_Of_Line_Node := Empty_Node;
1623 Previous_Line_Node := Empty_Node;
1624 Previous_End_Node := Empty_Node;
1625 Unkept_Comments := False;
1626 Comments.Set_Last (0);
1627 end Reset_State;
1628
1629 ----------------------
1630 -- Restore_And_Free --
1631 ----------------------
1632
1633 procedure Restore_And_Free (S : in out Comment_State) is
1634 procedure Unchecked_Free is new
1635 Ada.Unchecked_Deallocation (Comment_Array, Comments_Ptr);
1636
1637 begin
1638 End_Of_Line_Node := S.End_Of_Line_Node;
1639 Previous_Line_Node := S.Previous_Line_Node;
1640 Previous_End_Node := S.Previous_End_Node;
1641 Next_End_Nodes.Set_Last (0);
1642 Unkept_Comments := S.Unkept_Comments;
1643
1644 Comments.Set_Last (0);
1645
1646 for J in S.Comments'Range loop
1647 Comments.Increment_Last;
1648 Comments.Table (Comments.Last) := S.Comments (J);
1649 end loop;
1650
1651 Unchecked_Free (S.Comments);
1652 end Restore_And_Free;
1653
1654 ----------
1655 -- Save --
1656 ----------
1657
1658 procedure Save (S : out Comment_State) is
1659 Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last);
1660
1661 begin
1662 for J in 1 .. Comments.Last loop
1663 Cmts (J) := Comments.Table (J);
1664 end loop;
1665
1666 S :=
1667 (End_Of_Line_Node => End_Of_Line_Node,
1668 Previous_Line_Node => Previous_Line_Node,
1669 Previous_End_Node => Previous_End_Node,
1670 Unkept_Comments => Unkept_Comments,
1671 Comments => Cmts);
1672 end Save;
1673
1674 ----------
1675 -- Scan --
1676 ----------
1677
1678 procedure Scan (In_Tree : Project_Node_Tree_Ref) is
1679 Empty_Line : Boolean := False;
1680
1681 begin
1682 -- If there are comments, then they will not be kept. Set the flag and
1683 -- clear the comments.
1684
1685 if Comments.Last > 0 then
1686 Unkept_Comments := True;
1687 Comments.Set_Last (0);
1688 end if;
1689
1690 -- Loop until a token other that End_Of_Line or Comment is found
1691
1692 loop
1693 Prj.Err.Scanner.Scan;
1694
1695 case Token is
1696 when Tok_End_Of_Line =>
1697 if Prev_Token = Tok_End_Of_Line then
1698 Empty_Line := True;
1699
1700 if Comments.Last > 0 then
1701 Comments.Table (Comments.Last).Is_Followed_By_Empty_Line
1702 := True;
1703 end if;
1704 end if;
1705
1706 when Tok_Comment =>
1707 -- If this is a line comment, add it to the comment table
1708
1709 if Prev_Token = Tok_End_Of_Line
1710 or else Prev_Token = No_Token
1711 then
1712 Comments.Increment_Last;
1713 Comments.Table (Comments.Last) :=
1714 (Value => Comment_Id,
1715 Follows_Empty_Line => Empty_Line,
1716 Is_Followed_By_Empty_Line => False);
1717
1718 -- Otherwise, it is an end of line comment. If there is an
1719 -- end of line node specified, associate the comment with
1720 -- this node.
1721
1722 elsif Present (End_Of_Line_Node) then
1723 declare
1724 Zones : constant Project_Node_Id :=
1725 Comment_Zones_Of (End_Of_Line_Node, In_Tree);
1726 begin
1727 In_Tree.Project_Nodes.Table (Zones).Value := Comment_Id;
1728 end;
1729
1730 -- Otherwise, this end of line node cannot be kept
1731
1732 else
1733 Unkept_Comments := True;
1734 Comments.Set_Last (0);
1735 end if;
1736
1737 Empty_Line := False;
1738
1739 when others =>
1740
1741 -- If there are comments, where the first comment is not
1742 -- following an empty line, put the initial uninterrupted
1743 -- comment zone with the node of the preceding line (either
1744 -- a Previous_Line or a Previous_End node), if any.
1745
1746 if Comments.Last > 0 and then
1747 not Comments.Table (1).Follows_Empty_Line
1748 then
1749 if Present (Previous_Line_Node) then
1750 Add_Comments
1751 (To => Previous_Line_Node,
1752 Where => After,
1753 In_Tree => In_Tree);
1754
1755 elsif Present (Previous_End_Node) then
1756 Add_Comments
1757 (To => Previous_End_Node,
1758 Where => After_End,
1759 In_Tree => In_Tree);
1760 end if;
1761 end if;
1762
1763 -- If there are still comments and the token is "end", then
1764 -- put these comments with the Next_End node, if any;
1765 -- otherwise, these comments cannot be kept. Always clear
1766 -- the comments.
1767
1768 if Comments.Last > 0 and then Token = Tok_End then
1769 if Next_End_Nodes.Last > 0 then
1770 Add_Comments
1771 (To => Next_End_Nodes.Table (Next_End_Nodes.Last),
1772 Where => Before_End,
1773 In_Tree => In_Tree);
1774
1775 else
1776 Unkept_Comments := True;
1777 end if;
1778
1779 Comments.Set_Last (0);
1780 end if;
1781
1782 -- Reset the End_Of_Line, Previous_Line and Previous_End nodes
1783 -- so that they are not used again.
1784
1785 End_Of_Line_Node := Empty_Node;
1786 Previous_Line_Node := Empty_Node;
1787 Previous_End_Node := Empty_Node;
1788
1789 -- And return
1790
1791 exit;
1792 end case;
1793 end loop;
1794 end Scan;
1795
1796 ------------------------------------
1797 -- Set_Associative_Array_Index_Of --
1798 ------------------------------------
1799
1800 procedure Set_Associative_Array_Index_Of
1801 (Node : Project_Node_Id;
1802 In_Tree : Project_Node_Tree_Ref;
1803 To : Name_Id)
1804 is
1805 begin
1806 pragma Assert
1807 (Present (Node)
1808 and then
1809 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1810 or else
1811 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1812 In_Tree.Project_Nodes.Table (Node).Value := To;
1813 end Set_Associative_Array_Index_Of;
1814
1815 --------------------------------
1816 -- Set_Associative_Package_Of --
1817 --------------------------------
1818
1819 procedure Set_Associative_Package_Of
1820 (Node : Project_Node_Id;
1821 In_Tree : Project_Node_Tree_Ref;
1822 To : Project_Node_Id)
1823 is
1824 begin
1825 pragma Assert
1826 (Present (Node)
1827 and then
1828 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
1829 In_Tree.Project_Nodes.Table (Node).Field3 := To;
1830 end Set_Associative_Package_Of;
1831
1832 --------------------------------
1833 -- Set_Associative_Project_Of --
1834 --------------------------------
1835
1836 procedure Set_Associative_Project_Of
1837 (Node : Project_Node_Id;
1838 In_Tree : Project_Node_Tree_Ref;
1839 To : Project_Node_Id)
1840 is
1841 begin
1842 pragma Assert
1843 (Present (Node)
1844 and then
1845 (In_Tree.Project_Nodes.Table (Node).Kind =
1846 N_Attribute_Declaration));
1847 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1848 end Set_Associative_Project_Of;
1849
1850 --------------------------
1851 -- Set_Case_Insensitive --
1852 --------------------------
1853
1854 procedure Set_Case_Insensitive
1855 (Node : Project_Node_Id;
1856 In_Tree : Project_Node_Tree_Ref;
1857 To : Boolean)
1858 is
1859 begin
1860 pragma Assert
1861 (Present (Node)
1862 and then
1863 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1864 or else
1865 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1866 In_Tree.Project_Nodes.Table (Node).Flag1 := To;
1867 end Set_Case_Insensitive;
1868
1869 ------------------------------------
1870 -- Set_Case_Variable_Reference_Of --
1871 ------------------------------------
1872
1873 procedure Set_Case_Variable_Reference_Of
1874 (Node : Project_Node_Id;
1875 In_Tree : Project_Node_Tree_Ref;
1876 To : Project_Node_Id)
1877 is
1878 begin
1879 pragma Assert
1880 (Present (Node)
1881 and then
1882 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1883 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1884 end Set_Case_Variable_Reference_Of;
1885
1886 ---------------------------
1887 -- Set_Current_Item_Node --
1888 ---------------------------
1889
1890 procedure Set_Current_Item_Node
1891 (Node : Project_Node_Id;
1892 In_Tree : Project_Node_Tree_Ref;
1893 To : Project_Node_Id)
1894 is
1895 begin
1896 pragma Assert
1897 (Present (Node)
1898 and then
1899 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1900 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1901 end Set_Current_Item_Node;
1902
1903 ----------------------
1904 -- Set_Current_Term --
1905 ----------------------
1906
1907 procedure Set_Current_Term
1908 (Node : Project_Node_Id;
1909 In_Tree : Project_Node_Tree_Ref;
1910 To : Project_Node_Id)
1911 is
1912 begin
1913 pragma Assert
1914 (Present (Node)
1915 and then
1916 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1917 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1918 end Set_Current_Term;
1919
1920 --------------------
1921 -- Set_Default_Of --
1922 --------------------
1923
1924 procedure Set_Default_Of
1925 (Node : Project_Node_Id;
1926 In_Tree : Project_Node_Tree_Ref;
1927 To : Attribute_Default_Value)
1928 is
1929 begin
1930 pragma Assert
1931 (Present (Node)
1932 and then
1933 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference);
1934 In_Tree.Project_Nodes.Table (Node).Default := To;
1935 end Set_Default_Of;
1936
1937 ----------------------
1938 -- Set_Directory_Of --
1939 ----------------------
1940
1941 procedure Set_Directory_Of
1942 (Node : Project_Node_Id;
1943 In_Tree : Project_Node_Tree_Ref;
1944 To : Path_Name_Type)
1945 is
1946 begin
1947 pragma Assert
1948 (Present (Node)
1949 and then
1950 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1951 In_Tree.Project_Nodes.Table (Node).Directory := To;
1952 end Set_Directory_Of;
1953
1954 ---------------------
1955 -- Set_End_Of_Line --
1956 ---------------------
1957
1958 procedure Set_End_Of_Line (To : Project_Node_Id) is
1959 begin
1960 End_Of_Line_Node := To;
1961 end Set_End_Of_Line;
1962
1963 ----------------------------
1964 -- Set_Expression_Kind_Of --
1965 ----------------------------
1966
1967 procedure Set_Expression_Kind_Of
1968 (Node : Project_Node_Id;
1969 In_Tree : Project_Node_Tree_Ref;
1970 To : Variable_Kind)
1971 is
1972 begin
1973 pragma Assert
1974 (Present (Node)
1975 and then -- should use Nkind_In here ??? why not???
1976 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
1977 or else
1978 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1979 or else
1980 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
1981 or else
1982 In_Tree.Project_Nodes.Table (Node).Kind =
1983 N_Typed_Variable_Declaration
1984 or else
1985 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
1986 or else
1987 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
1988 or else
1989 In_Tree.Project_Nodes.Table (Node).Kind = N_Term
1990 or else
1991 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1992 or else
1993 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference
1994 or else
1995 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value));
1996 In_Tree.Project_Nodes.Table (Node).Expr_Kind := To;
1997 end Set_Expression_Kind_Of;
1998
1999 -----------------------
2000 -- Set_Expression_Of --
2001 -----------------------
2002
2003 procedure Set_Expression_Of
2004 (Node : Project_Node_Id;
2005 In_Tree : Project_Node_Tree_Ref;
2006 To : Project_Node_Id)
2007 is
2008 begin
2009 pragma Assert
2010 (Present (Node)
2011 and then
2012 (In_Tree.Project_Nodes.Table (Node).Kind =
2013 N_Attribute_Declaration
2014 or else
2015 In_Tree.Project_Nodes.Table (Node).Kind =
2016 N_Typed_Variable_Declaration
2017 or else
2018 In_Tree.Project_Nodes.Table (Node).Kind =
2019 N_Variable_Declaration));
2020 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2021 end Set_Expression_Of;
2022
2023 -------------------------------
2024 -- Set_External_Reference_Of --
2025 -------------------------------
2026
2027 procedure Set_External_Reference_Of
2028 (Node : Project_Node_Id;
2029 In_Tree : Project_Node_Tree_Ref;
2030 To : Project_Node_Id)
2031 is
2032 begin
2033 pragma Assert
2034 (Present (Node)
2035 and then
2036 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
2037 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2038 end Set_External_Reference_Of;
2039
2040 -----------------------------
2041 -- Set_External_Default_Of --
2042 -----------------------------
2043
2044 procedure Set_External_Default_Of
2045 (Node : Project_Node_Id;
2046 In_Tree : Project_Node_Tree_Ref;
2047 To : Project_Node_Id)
2048 is
2049 begin
2050 pragma Assert
2051 (Present (Node)
2052 and then
2053 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
2054 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2055 end Set_External_Default_Of;
2056
2057 ----------------------------
2058 -- Set_First_Case_Item_Of --
2059 ----------------------------
2060
2061 procedure Set_First_Case_Item_Of
2062 (Node : Project_Node_Id;
2063 In_Tree : Project_Node_Tree_Ref;
2064 To : Project_Node_Id)
2065 is
2066 begin
2067 pragma Assert
2068 (Present (Node)
2069 and then
2070 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
2071 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2072 end Set_First_Case_Item_Of;
2073
2074 -------------------------
2075 -- Set_First_Choice_Of --
2076 -------------------------
2077
2078 procedure Set_First_Choice_Of
2079 (Node : Project_Node_Id;
2080 In_Tree : Project_Node_Tree_Ref;
2081 To : Project_Node_Id)
2082 is
2083 begin
2084 pragma Assert
2085 (Present (Node)
2086 and then
2087 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
2088 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2089 end Set_First_Choice_Of;
2090
2091 -----------------------------
2092 -- Set_First_Comment_After --
2093 -----------------------------
2094
2095 procedure Set_First_Comment_After
2096 (Node : Project_Node_Id;
2097 In_Tree : Project_Node_Tree_Ref;
2098 To : Project_Node_Id)
2099 is
2100 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2101 begin
2102 In_Tree.Project_Nodes.Table (Zone).Field2 := To;
2103 end Set_First_Comment_After;
2104
2105 ---------------------------------
2106 -- Set_First_Comment_After_End --
2107 ---------------------------------
2108
2109 procedure Set_First_Comment_After_End
2110 (Node : Project_Node_Id;
2111 In_Tree : Project_Node_Tree_Ref;
2112 To : Project_Node_Id)
2113 is
2114 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2115 begin
2116 In_Tree.Project_Nodes.Table (Zone).Comments := To;
2117 end Set_First_Comment_After_End;
2118
2119 ------------------------------
2120 -- Set_First_Comment_Before --
2121 ------------------------------
2122
2123 procedure Set_First_Comment_Before
2124 (Node : Project_Node_Id;
2125 In_Tree : Project_Node_Tree_Ref;
2126 To : Project_Node_Id)
2127 is
2128 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2129 begin
2130 In_Tree.Project_Nodes.Table (Zone).Field1 := To;
2131 end Set_First_Comment_Before;
2132
2133 ----------------------------------
2134 -- Set_First_Comment_Before_End --
2135 ----------------------------------
2136
2137 procedure Set_First_Comment_Before_End
2138 (Node : Project_Node_Id;
2139 In_Tree : Project_Node_Tree_Ref;
2140 To : Project_Node_Id)
2141 is
2142 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2143 begin
2144 In_Tree.Project_Nodes.Table (Zone).Field2 := To;
2145 end Set_First_Comment_Before_End;
2146
2147 ------------------------
2148 -- Set_Next_Case_Item --
2149 ------------------------
2150
2151 procedure Set_Next_Case_Item
2152 (Node : Project_Node_Id;
2153 In_Tree : Project_Node_Tree_Ref;
2154 To : Project_Node_Id)
2155 is
2156 begin
2157 pragma Assert
2158 (Present (Node)
2159 and then
2160 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
2161 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2162 end Set_Next_Case_Item;
2163
2164 ----------------------
2165 -- Set_Next_Comment --
2166 ----------------------
2167
2168 procedure Set_Next_Comment
2169 (Node : Project_Node_Id;
2170 In_Tree : Project_Node_Tree_Ref;
2171 To : Project_Node_Id)
2172 is
2173 begin
2174 pragma Assert
2175 (Present (Node)
2176 and then
2177 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
2178 In_Tree.Project_Nodes.Table (Node).Comments := To;
2179 end Set_Next_Comment;
2180
2181 -----------------------------------
2182 -- Set_First_Declarative_Item_Of --
2183 -----------------------------------
2184
2185 procedure Set_First_Declarative_Item_Of
2186 (Node : Project_Node_Id;
2187 In_Tree : Project_Node_Tree_Ref;
2188 To : Project_Node_Id)
2189 is
2190 begin
2191 pragma Assert
2192 (Present (Node)
2193 and then
2194 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
2195 or else
2196 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
2197 or else
2198 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2199
2200 if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
2201 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2202 else
2203 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2204 end if;
2205 end Set_First_Declarative_Item_Of;
2206
2207 ----------------------------------
2208 -- Set_First_Expression_In_List --
2209 ----------------------------------
2210
2211 procedure Set_First_Expression_In_List
2212 (Node : Project_Node_Id;
2213 In_Tree : Project_Node_Tree_Ref;
2214 To : Project_Node_Id)
2215 is
2216 begin
2217 pragma Assert
2218 (Present (Node)
2219 and then
2220 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
2221 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2222 end Set_First_Expression_In_List;
2223
2224 ------------------------------
2225 -- Set_First_Literal_String --
2226 ------------------------------
2227
2228 procedure Set_First_Literal_String
2229 (Node : Project_Node_Id;
2230 In_Tree : Project_Node_Tree_Ref;
2231 To : Project_Node_Id)
2232 is
2233 begin
2234 pragma Assert
2235 (Present (Node)
2236 and then
2237 In_Tree.Project_Nodes.Table (Node).Kind =
2238 N_String_Type_Declaration);
2239 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2240 end Set_First_Literal_String;
2241
2242 --------------------------
2243 -- Set_First_Package_Of --
2244 --------------------------
2245
2246 procedure Set_First_Package_Of
2247 (Node : Project_Node_Id;
2248 In_Tree : Project_Node_Tree_Ref;
2249 To : Package_Declaration_Id)
2250 is
2251 begin
2252 pragma Assert
2253 (Present (Node)
2254 and then
2255 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2256 In_Tree.Project_Nodes.Table (Node).Packages := To;
2257 end Set_First_Package_Of;
2258
2259 ------------------------------
2260 -- Set_First_String_Type_Of --
2261 ------------------------------
2262
2263 procedure Set_First_String_Type_Of
2264 (Node : Project_Node_Id;
2265 In_Tree : Project_Node_Tree_Ref;
2266 To : Project_Node_Id)
2267 is
2268 begin
2269 pragma Assert
2270 (Present (Node)
2271 and then
2272 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2273 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2274 end Set_First_String_Type_Of;
2275
2276 --------------------
2277 -- Set_First_Term --
2278 --------------------
2279
2280 procedure Set_First_Term
2281 (Node : Project_Node_Id;
2282 In_Tree : Project_Node_Tree_Ref;
2283 To : Project_Node_Id)
2284 is
2285 begin
2286 pragma Assert
2287 (Present (Node)
2288 and then
2289 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2290 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2291 end Set_First_Term;
2292
2293 ---------------------------
2294 -- Set_First_Variable_Of --
2295 ---------------------------
2296
2297 procedure Set_First_Variable_Of
2298 (Node : Project_Node_Id;
2299 In_Tree : Project_Node_Tree_Ref;
2300 To : Variable_Node_Id)
2301 is
2302 begin
2303 pragma Assert
2304 (Present (Node)
2305 and then
2306 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2307 or else
2308 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2309 In_Tree.Project_Nodes.Table (Node).Variables := To;
2310 end Set_First_Variable_Of;
2311
2312 ------------------------------
2313 -- Set_First_With_Clause_Of --
2314 ------------------------------
2315
2316 procedure Set_First_With_Clause_Of
2317 (Node : Project_Node_Id;
2318 In_Tree : Project_Node_Tree_Ref;
2319 To : Project_Node_Id)
2320 is
2321 begin
2322 pragma Assert
2323 (Present (Node)
2324 and then
2325 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2326 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2327 end Set_First_With_Clause_Of;
2328
2329 --------------------------
2330 -- Set_Is_Extending_All --
2331 --------------------------
2332
2333 procedure Set_Is_Extending_All
2334 (Node : Project_Node_Id;
2335 In_Tree : Project_Node_Tree_Ref)
2336 is
2337 begin
2338 pragma Assert
2339 (Present (Node)
2340 and then
2341 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2342 or else
2343 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2344 In_Tree.Project_Nodes.Table (Node).Flag2 := True;
2345 end Set_Is_Extending_All;
2346
2347 -----------------------------
2348 -- Set_Is_Not_Last_In_List --
2349 -----------------------------
2350
2351 procedure Set_Is_Not_Last_In_List
2352 (Node : Project_Node_Id;
2353 In_Tree : Project_Node_Tree_Ref)
2354 is
2355 begin
2356 pragma Assert
2357 (Present (Node)
2358 and then In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2359 In_Tree.Project_Nodes.Table (Node).Flag1 := True;
2360 end Set_Is_Not_Last_In_List;
2361
2362 -----------------
2363 -- Set_Kind_Of --
2364 -----------------
2365
2366 procedure Set_Kind_Of
2367 (Node : Project_Node_Id;
2368 In_Tree : Project_Node_Tree_Ref;
2369 To : Project_Node_Kind)
2370 is
2371 begin
2372 pragma Assert (Present (Node));
2373 In_Tree.Project_Nodes.Table (Node).Kind := To;
2374 end Set_Kind_Of;
2375
2376 ---------------------
2377 -- Set_Location_Of --
2378 ---------------------
2379
2380 procedure Set_Location_Of
2381 (Node : Project_Node_Id;
2382 In_Tree : Project_Node_Tree_Ref;
2383 To : Source_Ptr)
2384 is
2385 begin
2386 pragma Assert (Present (Node));
2387 In_Tree.Project_Nodes.Table (Node).Location := To;
2388 end Set_Location_Of;
2389
2390 -----------------------------
2391 -- Set_Extended_Project_Of --
2392 -----------------------------
2393
2394 procedure Set_Extended_Project_Of
2395 (Node : Project_Node_Id;
2396 In_Tree : Project_Node_Tree_Ref;
2397 To : Project_Node_Id)
2398 is
2399 begin
2400 pragma Assert
2401 (Present (Node)
2402 and then
2403 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2404 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2405 end Set_Extended_Project_Of;
2406
2407 ----------------------------------
2408 -- Set_Extended_Project_Path_Of --
2409 ----------------------------------
2410
2411 procedure Set_Extended_Project_Path_Of
2412 (Node : Project_Node_Id;
2413 In_Tree : Project_Node_Tree_Ref;
2414 To : Path_Name_Type)
2415 is
2416 begin
2417 pragma Assert
2418 (Present (Node)
2419 and then
2420 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2421 In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To);
2422 end Set_Extended_Project_Path_Of;
2423
2424 ------------------------------
2425 -- Set_Extending_Project_Of --
2426 ------------------------------
2427
2428 procedure Set_Extending_Project_Of
2429 (Node : Project_Node_Id;
2430 In_Tree : Project_Node_Tree_Ref;
2431 To : Project_Node_Id)
2432 is
2433 begin
2434 pragma Assert
2435 (Present (Node)
2436 and then
2437 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2438 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2439 end Set_Extending_Project_Of;
2440
2441 -----------------
2442 -- Set_Name_Of --
2443 -----------------
2444
2445 procedure Set_Name_Of
2446 (Node : Project_Node_Id;
2447 In_Tree : Project_Node_Tree_Ref;
2448 To : Name_Id)
2449 is
2450 begin
2451 pragma Assert (Present (Node));
2452 In_Tree.Project_Nodes.Table (Node).Name := To;
2453 end Set_Name_Of;
2454
2455 -------------------------
2456 -- Set_Display_Name_Of --
2457 -------------------------
2458
2459 procedure Set_Display_Name_Of
2460 (Node : Project_Node_Id;
2461 In_Tree : Project_Node_Tree_Ref;
2462 To : Name_Id)
2463 is
2464 begin
2465 pragma Assert
2466 (Present (Node)
2467 and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2468 In_Tree.Project_Nodes.Table (Node).Display_Name := To;
2469 end Set_Display_Name_Of;
2470
2471 -------------------------------
2472 -- Set_Next_Declarative_Item --
2473 -------------------------------
2474
2475 procedure Set_Next_Declarative_Item
2476 (Node : Project_Node_Id;
2477 In_Tree : Project_Node_Tree_Ref;
2478 To : Project_Node_Id)
2479 is
2480 begin
2481 pragma Assert
2482 (Present (Node)
2483 and then
2484 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
2485 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2486 end Set_Next_Declarative_Item;
2487
2488 -----------------------
2489 -- Set_Next_End_Node --
2490 -----------------------
2491
2492 procedure Set_Next_End_Node (To : Project_Node_Id) is
2493 begin
2494 Next_End_Nodes.Increment_Last;
2495 Next_End_Nodes.Table (Next_End_Nodes.Last) := To;
2496 end Set_Next_End_Node;
2497
2498 ---------------------------------
2499 -- Set_Next_Expression_In_List --
2500 ---------------------------------
2501
2502 procedure Set_Next_Expression_In_List
2503 (Node : Project_Node_Id;
2504 In_Tree : Project_Node_Tree_Ref;
2505 To : Project_Node_Id)
2506 is
2507 begin
2508 pragma Assert
2509 (Present (Node)
2510 and then
2511 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2512 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2513 end Set_Next_Expression_In_List;
2514
2515 -----------------------------
2516 -- Set_Next_Literal_String --
2517 -----------------------------
2518
2519 procedure Set_Next_Literal_String
2520 (Node : Project_Node_Id;
2521 In_Tree : Project_Node_Tree_Ref;
2522 To : Project_Node_Id)
2523 is
2524 begin
2525 pragma Assert
2526 (Present (Node)
2527 and then
2528 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
2529 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2530 end Set_Next_Literal_String;
2531
2532 ---------------------------------
2533 -- Set_Next_Package_In_Project --
2534 ---------------------------------
2535
2536 procedure Set_Next_Package_In_Project
2537 (Node : Project_Node_Id;
2538 In_Tree : Project_Node_Tree_Ref;
2539 To : Project_Node_Id)
2540 is
2541 begin
2542 pragma Assert
2543 (Present (Node)
2544 and then
2545 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2546 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2547 end Set_Next_Package_In_Project;
2548
2549 --------------------------
2550 -- Set_Next_String_Type --
2551 --------------------------
2552
2553 procedure Set_Next_String_Type
2554 (Node : Project_Node_Id;
2555 In_Tree : Project_Node_Tree_Ref;
2556 To : Project_Node_Id)
2557 is
2558 begin
2559 pragma Assert
2560 (Present (Node)
2561 and then
2562 In_Tree.Project_Nodes.Table (Node).Kind =
2563 N_String_Type_Declaration);
2564 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2565 end Set_Next_String_Type;
2566
2567 -------------------
2568 -- Set_Next_Term --
2569 -------------------
2570
2571 procedure Set_Next_Term
2572 (Node : Project_Node_Id;
2573 In_Tree : Project_Node_Tree_Ref;
2574 To : Project_Node_Id)
2575 is
2576 begin
2577 pragma Assert
2578 (Present (Node)
2579 and then
2580 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
2581 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2582 end Set_Next_Term;
2583
2584 -----------------------
2585 -- Set_Next_Variable --
2586 -----------------------
2587
2588 procedure Set_Next_Variable
2589 (Node : Project_Node_Id;
2590 In_Tree : Project_Node_Tree_Ref;
2591 To : Project_Node_Id)
2592 is
2593 begin
2594 pragma Assert
2595 (Present (Node)
2596 and then
2597 (In_Tree.Project_Nodes.Table (Node).Kind =
2598 N_Typed_Variable_Declaration
2599 or else
2600 In_Tree.Project_Nodes.Table (Node).Kind =
2601 N_Variable_Declaration));
2602 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2603 end Set_Next_Variable;
2604
2605 -----------------------------
2606 -- Set_Next_With_Clause_Of --
2607 -----------------------------
2608
2609 procedure Set_Next_With_Clause_Of
2610 (Node : Project_Node_Id;
2611 In_Tree : Project_Node_Tree_Ref;
2612 To : Project_Node_Id)
2613 is
2614 begin
2615 pragma Assert
2616 (Present (Node)
2617 and then
2618 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2619 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2620 end Set_Next_With_Clause_Of;
2621
2622 -----------------------
2623 -- Set_Package_Id_Of --
2624 -----------------------
2625
2626 procedure Set_Package_Id_Of
2627 (Node : Project_Node_Id;
2628 In_Tree : Project_Node_Tree_Ref;
2629 To : Package_Node_Id)
2630 is
2631 begin
2632 pragma Assert
2633 (Present (Node)
2634 and then
2635 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2636 In_Tree.Project_Nodes.Table (Node).Pkg_Id := To;
2637 end Set_Package_Id_Of;
2638
2639 -------------------------
2640 -- Set_Package_Node_Of --
2641 -------------------------
2642
2643 procedure Set_Package_Node_Of
2644 (Node : Project_Node_Id;
2645 In_Tree : Project_Node_Tree_Ref;
2646 To : Project_Node_Id)
2647 is
2648 begin
2649 pragma Assert
2650 (Present (Node)
2651 and then
2652 (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2653 or else
2654 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2655 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2656 end Set_Package_Node_Of;
2657
2658 ----------------------
2659 -- Set_Path_Name_Of --
2660 ----------------------
2661
2662 procedure Set_Path_Name_Of
2663 (Node : Project_Node_Id;
2664 In_Tree : Project_Node_Tree_Ref;
2665 To : Path_Name_Type)
2666 is
2667 begin
2668 pragma Assert
2669 (Present (Node)
2670 and then
2671 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2672 or else
2673 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2674 In_Tree.Project_Nodes.Table (Node).Path_Name := To;
2675 end Set_Path_Name_Of;
2676
2677 ---------------------------
2678 -- Set_Previous_End_Node --
2679 ---------------------------
2680 procedure Set_Previous_End_Node (To : Project_Node_Id) is
2681 begin
2682 Previous_End_Node := To;
2683 end Set_Previous_End_Node;
2684
2685 ----------------------------
2686 -- Set_Previous_Line_Node --
2687 ----------------------------
2688
2689 procedure Set_Previous_Line_Node (To : Project_Node_Id) is
2690 begin
2691 Previous_Line_Node := To;
2692 end Set_Previous_Line_Node;
2693
2694 --------------------------------
2695 -- Set_Project_Declaration_Of --
2696 --------------------------------
2697
2698 procedure Set_Project_Declaration_Of
2699 (Node : Project_Node_Id;
2700 In_Tree : Project_Node_Tree_Ref;
2701 To : Project_Node_Id)
2702 is
2703 begin
2704 pragma Assert
2705 (Present (Node)
2706 and then
2707 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2708 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2709 end Set_Project_Declaration_Of;
2710
2711 ------------------------------
2712 -- Set_Project_Qualifier_Of --
2713 ------------------------------
2714
2715 procedure Set_Project_Qualifier_Of
2716 (Node : Project_Node_Id;
2717 In_Tree : Project_Node_Tree_Ref;
2718 To : Project_Qualifier)
2719 is
2720 begin
2721 pragma Assert
2722 (Present (Node)
2723 and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2724 In_Tree.Project_Nodes.Table (Node).Qualifier := To;
2725 end Set_Project_Qualifier_Of;
2726
2727 ---------------------------
2728 -- Set_Parent_Project_Of --
2729 ---------------------------
2730
2731 procedure Set_Parent_Project_Of
2732 (Node : Project_Node_Id;
2733 In_Tree : Project_Node_Tree_Ref;
2734 To : Project_Node_Id)
2735 is
2736 begin
2737 pragma Assert
2738 (Present (Node)
2739 and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2740 In_Tree.Project_Nodes.Table (Node).Field4 := To;
2741 end Set_Parent_Project_Of;
2742
2743 -----------------------------------------------
2744 -- Set_Project_File_Includes_Unkept_Comments --
2745 -----------------------------------------------
2746
2747 procedure Set_Project_File_Includes_Unkept_Comments
2748 (Node : Project_Node_Id;
2749 In_Tree : Project_Node_Tree_Ref;
2750 To : Boolean)
2751 is
2752 Declaration : constant Project_Node_Id :=
2753 Project_Declaration_Of (Node, In_Tree);
2754 begin
2755 In_Tree.Project_Nodes.Table (Declaration).Flag1 := To;
2756 end Set_Project_File_Includes_Unkept_Comments;
2757
2758 -------------------------
2759 -- Set_Project_Node_Of --
2760 -------------------------
2761
2762 procedure Set_Project_Node_Of
2763 (Node : Project_Node_Id;
2764 In_Tree : Project_Node_Tree_Ref;
2765 To : Project_Node_Id;
2766 Limited_With : Boolean := False)
2767 is
2768 begin
2769 pragma Assert
2770 (Present (Node)
2771 and then
2772 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2773 or else
2774 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2775 or else
2776 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2777 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2778
2779 if In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2780 and then not Limited_With
2781 then
2782 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2783 end if;
2784 end Set_Project_Node_Of;
2785
2786 ---------------------------------------
2787 -- Set_Project_Of_Renamed_Package_Of --
2788 ---------------------------------------
2789
2790 procedure Set_Project_Of_Renamed_Package_Of
2791 (Node : Project_Node_Id;
2792 In_Tree : Project_Node_Tree_Ref;
2793 To : Project_Node_Id)
2794 is
2795 begin
2796 pragma Assert
2797 (Present (Node)
2798 and then
2799 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2800 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2801 end Set_Project_Of_Renamed_Package_Of;
2802
2803 -------------------------
2804 -- Set_Source_Index_Of --
2805 -------------------------
2806
2807 procedure Set_Source_Index_Of
2808 (Node : Project_Node_Id;
2809 In_Tree : Project_Node_Tree_Ref;
2810 To : Int)
2811 is
2812 begin
2813 pragma Assert
2814 (Present (Node)
2815 and then
2816 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2817 or else
2818 In_Tree.Project_Nodes.Table (Node).Kind =
2819 N_Attribute_Declaration));
2820 In_Tree.Project_Nodes.Table (Node).Src_Index := To;
2821 end Set_Source_Index_Of;
2822
2823 ------------------------
2824 -- Set_String_Type_Of --
2825 ------------------------
2826
2827 procedure Set_String_Type_Of
2828 (Node : Project_Node_Id;
2829 In_Tree : Project_Node_Tree_Ref;
2830 To : Project_Node_Id)
2831 is
2832 begin
2833 pragma Assert
2834 (Present (Node)
2835 and then
2836 (In_Tree.Project_Nodes.Table (Node).Kind =
2837 N_Variable_Reference
2838 or else
2839 In_Tree.Project_Nodes.Table (Node).Kind =
2840 N_Typed_Variable_Declaration)
2841 and then
2842 In_Tree.Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
2843
2844 if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2845 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2846 else
2847 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2848 end if;
2849 end Set_String_Type_Of;
2850
2851 -------------------------
2852 -- Set_String_Value_Of --
2853 -------------------------
2854
2855 procedure Set_String_Value_Of
2856 (Node : Project_Node_Id;
2857 In_Tree : Project_Node_Tree_Ref;
2858 To : Name_Id)
2859 is
2860 begin
2861 pragma Assert
2862 (Present (Node)
2863 and then
2864 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2865 or else
2866 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2867 or else
2868 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2869 In_Tree.Project_Nodes.Table (Node).Value := To;
2870 end Set_String_Value_Of;
2871
2872 ---------------------
2873 -- Source_Index_Of --
2874 ---------------------
2875
2876 function Source_Index_Of
2877 (Node : Project_Node_Id;
2878 In_Tree : Project_Node_Tree_Ref) return Int
2879 is
2880 begin
2881 pragma Assert
2882 (Present (Node)
2883 and then
2884 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2885 or else
2886 In_Tree.Project_Nodes.Table (Node).Kind =
2887 N_Attribute_Declaration));
2888 return In_Tree.Project_Nodes.Table (Node).Src_Index;
2889 end Source_Index_Of;
2890
2891 --------------------
2892 -- String_Type_Of --
2893 --------------------
2894
2895 function String_Type_Of
2896 (Node : Project_Node_Id;
2897 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
2898 is
2899 begin
2900 pragma Assert
2901 (Present (Node)
2902 and then
2903 (In_Tree.Project_Nodes.Table (Node).Kind =
2904 N_Variable_Reference
2905 or else
2906 In_Tree.Project_Nodes.Table (Node).Kind =
2907 N_Typed_Variable_Declaration));
2908
2909 if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2910 return In_Tree.Project_Nodes.Table (Node).Field3;
2911 else
2912 return In_Tree.Project_Nodes.Table (Node).Field2;
2913 end if;
2914 end String_Type_Of;
2915
2916 ---------------------
2917 -- String_Value_Of --
2918 ---------------------
2919
2920 function String_Value_Of
2921 (Node : Project_Node_Id;
2922 In_Tree : Project_Node_Tree_Ref) return Name_Id
2923 is
2924 begin
2925 pragma Assert
2926 (Present (Node)
2927 and then
2928 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2929 or else
2930 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2931 or else
2932 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2933 return In_Tree.Project_Nodes.Table (Node).Value;
2934 end String_Value_Of;
2935
2936 --------------------
2937 -- Value_Is_Valid --
2938 --------------------
2939
2940 function Value_Is_Valid
2941 (For_Typed_Variable : Project_Node_Id;
2942 In_Tree : Project_Node_Tree_Ref;
2943 Value : Name_Id) return Boolean
2944 is
2945 begin
2946 pragma Assert
2947 (Present (For_Typed_Variable)
2948 and then
2949 (In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind =
2950 N_Typed_Variable_Declaration));
2951
2952 declare
2953 Current_String : Project_Node_Id :=
2954 First_Literal_String
2955 (String_Type_Of (For_Typed_Variable, In_Tree),
2956 In_Tree);
2957
2958 begin
2959 while Present (Current_String)
2960 and then
2961 String_Value_Of (Current_String, In_Tree) /= Value
2962 loop
2963 Current_String :=
2964 Next_Literal_String (Current_String, In_Tree);
2965 end loop;
2966
2967 return Present (Current_String);
2968 end;
2969
2970 end Value_Is_Valid;
2971
2972 -------------------------------
2973 -- There_Are_Unkept_Comments --
2974 -------------------------------
2975
2976 function There_Are_Unkept_Comments return Boolean is
2977 begin
2978 return Unkept_Comments;
2979 end There_Are_Unkept_Comments;
2980
2981 --------------------
2982 -- Create_Project --
2983 --------------------
2984
2985 function Create_Project
2986 (In_Tree : Project_Node_Tree_Ref;
2987 Name : Name_Id;
2988 Full_Path : Path_Name_Type;
2989 Is_Config_File : Boolean := False) return Project_Node_Id
2990 is
2991 Project : Project_Node_Id;
2992 Qualifier : Project_Qualifier := Unspecified;
2993 begin
2994 Project := Default_Project_Node (In_Tree, N_Project);
2995 Set_Name_Of (Project, In_Tree, Name);
2996 Set_Display_Name_Of (Project, In_Tree, Name);
2997 Set_Directory_Of
2998 (Project, In_Tree,
2999 Path_Name_Type (Get_Directory (File_Name_Type (Full_Path))));
3000 Set_Path_Name_Of (Project, In_Tree, Full_Path);
3001
3002 Set_Project_Declaration_Of
3003 (Project, In_Tree,
3004 Default_Project_Node (In_Tree, N_Project_Declaration));
3005
3006 if Is_Config_File then
3007 Qualifier := Configuration;
3008 end if;
3009
3010 if not Is_Config_File then
3011 Prj.Tree.Tree_Private_Part.Projects_Htable.Set
3012 (In_Tree.Projects_HT,
3013 Name,
3014 Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
3015 (Name => Name,
3016 Resolved_Path => No_Path,
3017 Node => Project,
3018 Extended => False,
3019 From_Extended => False,
3020 Proj_Qualifier => Qualifier));
3021 end if;
3022
3023 return Project;
3024 end Create_Project;
3025
3026 ----------------
3027 -- Add_At_End --
3028 ----------------
3029
3030 procedure Add_At_End
3031 (Tree : Project_Node_Tree_Ref;
3032 Parent : Project_Node_Id;
3033 Expr : Project_Node_Id;
3034 Add_Before_First_Pkg : Boolean := False;
3035 Add_Before_First_Case : Boolean := False)
3036 is
3037 Real_Parent : Project_Node_Id;
3038 New_Decl, Decl, Next : Project_Node_Id;
3039 Last, L : Project_Node_Id;
3040
3041 begin
3042 if Kind_Of (Expr, Tree) /= N_Declarative_Item then
3043 New_Decl := Default_Project_Node (Tree, N_Declarative_Item);
3044 Set_Current_Item_Node (New_Decl, Tree, Expr);
3045 else
3046 New_Decl := Expr;
3047 end if;
3048
3049 if Kind_Of (Parent, Tree) = N_Project then
3050 Real_Parent := Project_Declaration_Of (Parent, Tree);
3051 else
3052 Real_Parent := Parent;
3053 end if;
3054
3055 Decl := First_Declarative_Item_Of (Real_Parent, Tree);
3056
3057 if Decl = Empty_Node then
3058 Set_First_Declarative_Item_Of (Real_Parent, Tree, New_Decl);
3059 else
3060 loop
3061 Next := Next_Declarative_Item (Decl, Tree);
3062 exit when Next = Empty_Node
3063 or else
3064 (Add_Before_First_Pkg
3065 and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
3066 N_Package_Declaration)
3067 or else
3068 (Add_Before_First_Case
3069 and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
3070 N_Case_Construction);
3071 Decl := Next;
3072 end loop;
3073
3074 -- In case Expr is in fact a range of declarative items
3075
3076 Last := New_Decl;
3077 loop
3078 L := Next_Declarative_Item (Last, Tree);
3079 exit when L = Empty_Node;
3080 Last := L;
3081 end loop;
3082
3083 -- In case Expr is in fact a range of declarative items
3084
3085 Last := New_Decl;
3086 loop
3087 L := Next_Declarative_Item (Last, Tree);
3088 exit when L = Empty_Node;
3089 Last := L;
3090 end loop;
3091
3092 Set_Next_Declarative_Item (Last, Tree, Next);
3093 Set_Next_Declarative_Item (Decl, Tree, New_Decl);
3094 end if;
3095 end Add_At_End;
3096
3097 ---------------------------
3098 -- Create_Literal_String --
3099 ---------------------------
3100
3101 function Create_Literal_String
3102 (Str : Namet.Name_Id;
3103 Tree : Project_Node_Tree_Ref) return Project_Node_Id
3104 is
3105 Node : Project_Node_Id;
3106 begin
3107 Node := Default_Project_Node (Tree, N_Literal_String, Prj.Single);
3108 Set_Next_Literal_String (Node, Tree, Empty_Node);
3109 Set_String_Value_Of (Node, Tree, Str);
3110 return Node;
3111 end Create_Literal_String;
3112
3113 ---------------------------
3114 -- Enclose_In_Expression --
3115 ---------------------------
3116
3117 function Enclose_In_Expression
3118 (Node : Project_Node_Id;
3119 Tree : Project_Node_Tree_Ref) return Project_Node_Id
3120 is
3121 Expr : Project_Node_Id;
3122 begin
3123 if Kind_Of (Node, Tree) /= N_Expression then
3124 Expr := Default_Project_Node (Tree, N_Expression, Single);
3125 Set_First_Term
3126 (Expr, Tree, Default_Project_Node (Tree, N_Term, Single));
3127 Set_Current_Term (First_Term (Expr, Tree), Tree, Node);
3128 return Expr;
3129 else
3130 return Node;
3131 end if;
3132 end Enclose_In_Expression;
3133
3134 --------------------
3135 -- Create_Package --
3136 --------------------
3137
3138 function Create_Package
3139 (Tree : Project_Node_Tree_Ref;
3140 Project : Project_Node_Id;
3141 Pkg : String) return Project_Node_Id
3142 is
3143 Pack : Project_Node_Id;
3144 N : Name_Id;
3145
3146 begin
3147 Name_Len := Pkg'Length;
3148 Name_Buffer (1 .. Name_Len) := Pkg;
3149 N := Name_Find;
3150
3151 -- Check if the package already exists
3152
3153 Pack := First_Package_Of (Project, Tree);
3154 while Pack /= Empty_Node loop
3155 if Prj.Tree.Name_Of (Pack, Tree) = N then
3156 return Pack;
3157 end if;
3158
3159 Pack := Next_Package_In_Project (Pack, Tree);
3160 end loop;
3161
3162 -- Create the package and add it to the declarative item
3163
3164 Pack := Default_Project_Node (Tree, N_Package_Declaration);
3165 Set_Name_Of (Pack, Tree, N);
3166
3167 -- Find the correct package id to use
3168
3169 Set_Package_Id_Of (Pack, Tree, Package_Node_Id_Of (N));
3170
3171 -- Add it to the list of packages
3172
3173 Set_Next_Package_In_Project
3174 (Pack, Tree, First_Package_Of (Project, Tree));
3175 Set_First_Package_Of (Project, Tree, Pack);
3176
3177 Add_At_End (Tree, Project_Declaration_Of (Project, Tree), Pack);
3178
3179 return Pack;
3180 end Create_Package;
3181
3182 ----------------------
3183 -- Create_Attribute --
3184 ----------------------
3185
3186 function Create_Attribute
3187 (Tree : Project_Node_Tree_Ref;
3188 Prj_Or_Pkg : Project_Node_Id;
3189 Name : Name_Id;
3190 Index_Name : Name_Id := No_Name;
3191 Kind : Variable_Kind := List;
3192 At_Index : Integer := 0;
3193 Value : Project_Node_Id := Empty_Node) return Project_Node_Id
3194 is
3195 Node : constant Project_Node_Id :=
3196 Default_Project_Node (Tree, N_Attribute_Declaration, Kind);
3197
3198 Case_Insensitive : Boolean;
3199
3200 Pkg : Package_Node_Id;
3201 Start_At : Attribute_Node_Id;
3202 Expr : Project_Node_Id;
3203
3204 begin
3205 Set_Name_Of (Node, Tree, Name);
3206
3207 if Index_Name /= No_Name then
3208 Set_Associative_Array_Index_Of (Node, Tree, Index_Name);
3209 end if;
3210
3211 if Prj_Or_Pkg /= Empty_Node then
3212 Add_At_End (Tree, Prj_Or_Pkg, Node);
3213 end if;
3214
3215 -- Find out the case sensitivity of the attribute
3216
3217 if Prj_Or_Pkg /= Empty_Node
3218 and then Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration
3219 then
3220 Pkg := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree));
3221 Start_At := First_Attribute_Of (Pkg);
3222 else
3223 Start_At := Attribute_First;
3224 end if;
3225
3226 Start_At := Attribute_Node_Id_Of (Name, Start_At);
3227 Case_Insensitive :=
3228 Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array;
3229 Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive;
3230
3231 if At_Index /= 0 then
3232 if Attribute_Kind_Of (Start_At) =
3233 Optional_Index_Associative_Array
3234 or else Attribute_Kind_Of (Start_At) =
3235 Optional_Index_Case_Insensitive_Associative_Array
3236 then
3237 -- Results in: for Name ("index" at index) use "value";
3238 -- This is currently only used for executables.
3239
3240 Set_Source_Index_Of (Node, Tree, To => Int (At_Index));
3241
3242 else
3243 -- Results in: for Name ("index") use "value" at index;
3244
3245 -- ??? This limitation makes no sense, we should be able to
3246 -- set the source index on an expression.
3247
3248 pragma Assert (Kind_Of (Value, Tree) = N_Literal_String);
3249 Set_Source_Index_Of (Value, Tree, To => Int (At_Index));
3250 end if;
3251 end if;
3252
3253 if Value /= Empty_Node then
3254 Expr := Enclose_In_Expression (Value, Tree);
3255 Set_Expression_Of (Node, Tree, Expr);
3256 end if;
3257
3258 return Node;
3259 end Create_Attribute;
3260
3261 end Prj.Tree;