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