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