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