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