1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Ada.Unchecked_Deallocation;
27 with Osint; use Osint;
30 package body Prj.Tree is
32 Node_With_Comments : constant array (Project_Node_Kind) of Boolean :=
34 N_With_Clause => True,
35 N_Project_Declaration => False,
36 N_Declarative_Item => False,
37 N_Package_Declaration => True,
38 N_String_Type_Declaration => True,
39 N_Literal_String => False,
40 N_Attribute_Declaration => True,
41 N_Typed_Variable_Declaration => True,
42 N_Variable_Declaration => True,
43 N_Expression => False,
45 N_Literal_String_List => False,
46 N_Variable_Reference => False,
47 N_External_Value => False,
48 N_Attribute_Reference => False,
49 N_Case_Construction => True,
51 N_Comment_Zones => True,
53 -- Indicates the kinds of node that may have associated comments
55 package Next_End_Nodes is new Table.Table
56 (Table_Component_Type => Project_Node_Id,
57 Table_Index_Type => Natural,
60 Table_Increment => 100,
61 Table_Name => "Next_End_Nodes");
62 -- A stack of nodes to indicates to what node the next "end" is associated
64 use Tree_Private_Part;
66 End_Of_Line_Node : Project_Node_Id := Empty_Node;
67 -- The node an end of line comment may be associated with
69 Previous_Line_Node : Project_Node_Id := Empty_Node;
70 -- The node an immediately following comment may be associated with
72 Previous_End_Node : Project_Node_Id := Empty_Node;
73 -- The node comments immediately following an "end" line may be
76 Unkept_Comments : Boolean := False;
77 -- Set to True when some comments may not be associated with any node
79 function Comment_Zones_Of
80 (Node : Project_Node_Id;
81 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
82 -- Returns the ID of the N_Comment_Zones node associated with node Node.
83 -- If there is not already an N_Comment_Zones node, create one and
84 -- associate it with node Node.
90 procedure Add_Comments
91 (To : Project_Node_Id;
92 In_Tree : Project_Node_Tree_Ref;
93 Where : Comment_Location) is
94 Zone : Project_Node_Id := Empty_Node;
95 Previous : Project_Node_Id := Empty_Node;
100 and then In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
102 Zone := In_Tree.Project_Nodes.Table (To).Comments;
106 -- Create new N_Comment_Zones node
108 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
109 In_Tree.Project_Nodes.Table
110 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
111 (Kind => N_Comment_Zones,
112 Qualifier => Unspecified,
113 Expr_Kind => Undefined,
114 Location => No_Location,
115 Directory => No_Path,
116 Variables => Empty_Node,
117 Packages => Empty_Node,
118 Pkg_Id => Empty_Package,
121 Path_Name => No_Path,
123 Field1 => Empty_Node,
124 Field2 => Empty_Node,
125 Field3 => Empty_Node,
126 Field4 => Empty_Node,
129 Comments => Empty_Node);
131 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
132 In_Tree.Project_Nodes.Table (To).Comments := Zone;
135 if Where = End_Of_Line then
136 In_Tree.Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
139 -- Get each comments in the Comments table and link them to node To
141 for J in 1 .. Comments.Last loop
143 -- Create new N_Comment node
145 if (Where = After or else Where = After_End) and then
146 Token /= Tok_EOF and then
147 Comments.Table (J).Follows_Empty_Line
149 Comments.Table (1 .. Comments.Last - J + 1) :=
150 Comments.Table (J .. Comments.Last);
151 Comments.Set_Last (Comments.Last - J + 1);
155 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
156 In_Tree.Project_Nodes.Table
157 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
159 Qualifier => Unspecified,
160 Expr_Kind => Undefined,
161 Flag1 => Comments.Table (J).Follows_Empty_Line,
163 Comments.Table (J).Is_Followed_By_Empty_Line,
164 Location => No_Location,
165 Directory => No_Path,
166 Variables => Empty_Node,
167 Packages => Empty_Node,
168 Pkg_Id => Empty_Package,
171 Path_Name => No_Path,
172 Value => Comments.Table (J).Value,
173 Field1 => Empty_Node,
174 Field2 => Empty_Node,
175 Field3 => Empty_Node,
176 Field4 => Empty_Node,
177 Comments => Empty_Node);
179 -- If this is the first comment, put it in the right field of
182 if No (Previous) then
185 In_Tree.Project_Nodes.Table (Zone).Field1 :=
186 Project_Node_Table.Last (In_Tree.Project_Nodes);
189 In_Tree.Project_Nodes.Table (Zone).Field2 :=
190 Project_Node_Table.Last (In_Tree.Project_Nodes);
193 In_Tree.Project_Nodes.Table (Zone).Field3 :=
194 Project_Node_Table.Last (In_Tree.Project_Nodes);
197 In_Tree.Project_Nodes.Table (Zone).Comments :=
198 Project_Node_Table.Last (In_Tree.Project_Nodes);
205 -- When it is not the first, link it to the previous one
207 In_Tree.Project_Nodes.Table (Previous).Comments :=
208 Project_Node_Table.Last (In_Tree.Project_Nodes);
211 -- This node becomes the previous one for the next comment, if
214 Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
218 -- Empty the Comments table, so that there is no risk to link the same
219 -- comments to another node.
221 Comments.Set_Last (0);
224 --------------------------------
225 -- Associative_Array_Index_Of --
226 --------------------------------
228 function Associative_Array_Index_Of
229 (Node : Project_Node_Id;
230 In_Tree : Project_Node_Tree_Ref) return Name_Id
236 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
238 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
239 return In_Tree.Project_Nodes.Table (Node).Value;
240 end Associative_Array_Index_Of;
242 ----------------------------
243 -- Associative_Package_Of --
244 ----------------------------
246 function Associative_Package_Of
247 (Node : Project_Node_Id;
248 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
254 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
255 return In_Tree.Project_Nodes.Table (Node).Field3;
256 end Associative_Package_Of;
258 ----------------------------
259 -- Associative_Project_Of --
260 ----------------------------
262 function Associative_Project_Of
263 (Node : Project_Node_Id;
264 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
270 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
271 return In_Tree.Project_Nodes.Table (Node).Field2;
272 end Associative_Project_Of;
274 ----------------------
275 -- Case_Insensitive --
276 ----------------------
278 function Case_Insensitive
279 (Node : Project_Node_Id;
280 In_Tree : Project_Node_Tree_Ref) return Boolean is
285 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
287 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
288 return In_Tree.Project_Nodes.Table (Node).Flag1;
289 end Case_Insensitive;
291 --------------------------------
292 -- Case_Variable_Reference_Of --
293 --------------------------------
295 function Case_Variable_Reference_Of
296 (Node : Project_Node_Id;
297 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
303 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
304 return In_Tree.Project_Nodes.Table (Node).Field1;
305 end Case_Variable_Reference_Of;
307 ----------------------
308 -- Comment_Zones_Of --
309 ----------------------
311 function Comment_Zones_Of
312 (Node : Project_Node_Id;
313 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
315 Zone : Project_Node_Id;
318 pragma Assert (Present (Node));
319 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
321 -- If there is not already an N_Comment_Zones associated, create a new
322 -- one and associate it with node Node.
325 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
326 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
327 In_Tree.Project_Nodes.Table (Zone) :=
328 (Kind => N_Comment_Zones,
329 Qualifier => Unspecified,
330 Location => No_Location,
331 Directory => No_Path,
332 Expr_Kind => Undefined,
333 Variables => Empty_Node,
334 Packages => Empty_Node,
335 Pkg_Id => Empty_Package,
338 Path_Name => No_Path,
340 Field1 => Empty_Node,
341 Field2 => Empty_Node,
342 Field3 => Empty_Node,
343 Field4 => Empty_Node,
346 Comments => Empty_Node);
347 In_Tree.Project_Nodes.Table (Node).Comments := Zone;
351 end Comment_Zones_Of;
353 -----------------------
354 -- Current_Item_Node --
355 -----------------------
357 function Current_Item_Node
358 (Node : Project_Node_Id;
359 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
365 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
366 return In_Tree.Project_Nodes.Table (Node).Field1;
367 end Current_Item_Node;
373 function Current_Term
374 (Node : Project_Node_Id;
375 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
381 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
382 return In_Tree.Project_Nodes.Table (Node).Field1;
385 --------------------------
386 -- Default_Project_Node --
387 --------------------------
389 function Default_Project_Node
390 (In_Tree : Project_Node_Tree_Ref;
391 Of_Kind : Project_Node_Kind;
392 And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id
394 Result : Project_Node_Id;
395 Zone : Project_Node_Id;
396 Previous : Project_Node_Id;
399 -- Create new node with specified kind and expression kind
401 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
402 In_Tree.Project_Nodes.Table
403 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
405 Qualifier => Unspecified,
406 Location => No_Location,
407 Directory => No_Path,
408 Expr_Kind => And_Expr_Kind,
409 Variables => Empty_Node,
410 Packages => Empty_Node,
411 Pkg_Id => Empty_Package,
414 Path_Name => No_Path,
416 Field1 => Empty_Node,
417 Field2 => Empty_Node,
418 Field3 => Empty_Node,
419 Field4 => Empty_Node,
422 Comments => Empty_Node);
424 -- Save the new node for the returned value
426 Result := Project_Node_Table.Last (In_Tree.Project_Nodes);
428 if Comments.Last > 0 then
430 -- If this is not a node with comments, then set the flag
432 if not Node_With_Comments (Of_Kind) then
433 Unkept_Comments := True;
435 elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then
437 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
438 In_Tree.Project_Nodes.Table
439 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
440 (Kind => N_Comment_Zones,
441 Qualifier => Unspecified,
442 Expr_Kind => Undefined,
443 Location => No_Location,
444 Directory => No_Path,
445 Variables => Empty_Node,
446 Packages => Empty_Node,
447 Pkg_Id => Empty_Package,
450 Path_Name => No_Path,
452 Field1 => Empty_Node,
453 Field2 => Empty_Node,
454 Field3 => Empty_Node,
455 Field4 => Empty_Node,
458 Comments => Empty_Node);
460 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
461 In_Tree.Project_Nodes.Table (Result).Comments := Zone;
462 Previous := Empty_Node;
464 for J in 1 .. Comments.Last loop
466 -- Create a new N_Comment node
468 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
469 In_Tree.Project_Nodes.Table
470 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
472 Qualifier => Unspecified,
473 Expr_Kind => Undefined,
474 Flag1 => Comments.Table (J).Follows_Empty_Line,
476 Comments.Table (J).Is_Followed_By_Empty_Line,
477 Location => No_Location,
478 Directory => No_Path,
479 Variables => Empty_Node,
480 Packages => Empty_Node,
481 Pkg_Id => Empty_Package,
484 Path_Name => No_Path,
485 Value => Comments.Table (J).Value,
486 Field1 => Empty_Node,
487 Field2 => Empty_Node,
488 Field3 => Empty_Node,
489 Field4 => Empty_Node,
490 Comments => Empty_Node);
492 -- Link it to the N_Comment_Zones node, if it is the first,
493 -- otherwise to the previous one.
495 if No (Previous) then
496 In_Tree.Project_Nodes.Table (Zone).Field1 :=
497 Project_Node_Table.Last (In_Tree.Project_Nodes);
500 In_Tree.Project_Nodes.Table (Previous).Comments :=
501 Project_Node_Table.Last (In_Tree.Project_Nodes);
504 -- This new node will be the previous one for the next
505 -- N_Comment node, if there is one.
507 Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
510 -- Empty the Comments table after all comments have been processed
512 Comments.Set_Last (0);
517 end Default_Project_Node;
523 function Directory_Of
524 (Node : Project_Node_Id;
525 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is
530 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
531 return In_Tree.Project_Nodes.Table (Node).Directory;
534 -------------------------
535 -- End_Of_Line_Comment --
536 -------------------------
538 function End_Of_Line_Comment
539 (Node : Project_Node_Id;
540 In_Tree : Project_Node_Tree_Ref) return Name_Id is
541 Zone : Project_Node_Id := Empty_Node;
544 pragma Assert (Present (Node));
545 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
550 return In_Tree.Project_Nodes.Table (Zone).Value;
552 end End_Of_Line_Comment;
554 ------------------------
555 -- Expression_Kind_Of --
556 ------------------------
558 function Expression_Kind_Of
559 (Node : Project_Node_Id;
560 In_Tree : Project_Node_Tree_Ref) return Variable_Kind is
565 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
567 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
569 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
571 In_Tree.Project_Nodes.Table (Node).Kind =
572 N_Typed_Variable_Declaration
574 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
576 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
578 In_Tree.Project_Nodes.Table (Node).Kind = N_Term
580 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
582 In_Tree.Project_Nodes.Table (Node).Kind =
583 N_Attribute_Reference));
585 return In_Tree.Project_Nodes.Table (Node).Expr_Kind;
586 end Expression_Kind_Of;
592 function Expression_Of
593 (Node : Project_Node_Id;
594 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
600 (In_Tree.Project_Nodes.Table (Node).Kind =
601 N_Attribute_Declaration
603 In_Tree.Project_Nodes.Table (Node).Kind =
604 N_Typed_Variable_Declaration
606 In_Tree.Project_Nodes.Table (Node).Kind =
607 N_Variable_Declaration));
609 return In_Tree.Project_Nodes.Table (Node).Field1;
612 -------------------------
613 -- Extended_Project_Of --
614 -------------------------
616 function Extended_Project_Of
617 (Node : Project_Node_Id;
618 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
624 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
625 return In_Tree.Project_Nodes.Table (Node).Field2;
626 end Extended_Project_Of;
628 ------------------------------
629 -- Extended_Project_Path_Of --
630 ------------------------------
632 function Extended_Project_Path_Of
633 (Node : Project_Node_Id;
634 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
640 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
641 return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value);
642 end Extended_Project_Path_Of;
644 --------------------------
645 -- Extending_Project_Of --
646 --------------------------
647 function Extending_Project_Of
648 (Node : Project_Node_Id;
649 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
655 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
656 return In_Tree.Project_Nodes.Table (Node).Field3;
657 end Extending_Project_Of;
659 ---------------------------
660 -- External_Reference_Of --
661 ---------------------------
663 function External_Reference_Of
664 (Node : Project_Node_Id;
665 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
671 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
672 return In_Tree.Project_Nodes.Table (Node).Field1;
673 end External_Reference_Of;
675 -------------------------
676 -- External_Default_Of --
677 -------------------------
679 function External_Default_Of
680 (Node : Project_Node_Id;
681 In_Tree : Project_Node_Tree_Ref)
682 return Project_Node_Id
688 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
689 return In_Tree.Project_Nodes.Table (Node).Field2;
690 end External_Default_Of;
692 ------------------------
693 -- First_Case_Item_Of --
694 ------------------------
696 function First_Case_Item_Of
697 (Node : Project_Node_Id;
698 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
704 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
705 return In_Tree.Project_Nodes.Table (Node).Field2;
706 end First_Case_Item_Of;
708 ---------------------
709 -- First_Choice_Of --
710 ---------------------
712 function First_Choice_Of
713 (Node : Project_Node_Id;
714 In_Tree : Project_Node_Tree_Ref)
715 return Project_Node_Id
721 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
722 return In_Tree.Project_Nodes.Table (Node).Field1;
725 -------------------------
726 -- First_Comment_After --
727 -------------------------
729 function First_Comment_After
730 (Node : Project_Node_Id;
731 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
733 Zone : Project_Node_Id := Empty_Node;
735 pragma Assert (Present (Node));
736 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
742 return In_Tree.Project_Nodes.Table (Zone).Field2;
744 end First_Comment_After;
746 -----------------------------
747 -- First_Comment_After_End --
748 -----------------------------
750 function First_Comment_After_End
751 (Node : Project_Node_Id;
752 In_Tree : Project_Node_Tree_Ref)
753 return Project_Node_Id
755 Zone : Project_Node_Id := Empty_Node;
758 pragma Assert (Present (Node));
759 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
765 return In_Tree.Project_Nodes.Table (Zone).Comments;
767 end First_Comment_After_End;
769 --------------------------
770 -- First_Comment_Before --
771 --------------------------
773 function First_Comment_Before
774 (Node : Project_Node_Id;
775 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
777 Zone : Project_Node_Id := Empty_Node;
780 pragma Assert (Present (Node));
781 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
787 return In_Tree.Project_Nodes.Table (Zone).Field1;
789 end First_Comment_Before;
791 ------------------------------
792 -- First_Comment_Before_End --
793 ------------------------------
795 function First_Comment_Before_End
796 (Node : Project_Node_Id;
797 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
799 Zone : Project_Node_Id := Empty_Node;
802 pragma Assert (Present (Node));
803 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
809 return In_Tree.Project_Nodes.Table (Zone).Field3;
811 end First_Comment_Before_End;
813 -------------------------------
814 -- First_Declarative_Item_Of --
815 -------------------------------
817 function First_Declarative_Item_Of
818 (Node : Project_Node_Id;
819 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
825 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
827 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
829 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
831 if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
832 return In_Tree.Project_Nodes.Table (Node).Field1;
834 return In_Tree.Project_Nodes.Table (Node).Field2;
836 end First_Declarative_Item_Of;
838 ------------------------------
839 -- First_Expression_In_List --
840 ------------------------------
842 function First_Expression_In_List
843 (Node : Project_Node_Id;
844 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
850 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
851 return In_Tree.Project_Nodes.Table (Node).Field1;
852 end First_Expression_In_List;
854 --------------------------
855 -- First_Literal_String --
856 --------------------------
858 function First_Literal_String
859 (Node : Project_Node_Id;
860 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
866 In_Tree.Project_Nodes.Table (Node).Kind =
867 N_String_Type_Declaration);
868 return In_Tree.Project_Nodes.Table (Node).Field1;
869 end First_Literal_String;
871 ----------------------
872 -- First_Package_Of --
873 ----------------------
875 function First_Package_Of
876 (Node : Project_Node_Id;
877 In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id
883 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
884 return In_Tree.Project_Nodes.Table (Node).Packages;
885 end First_Package_Of;
887 --------------------------
888 -- First_String_Type_Of --
889 --------------------------
891 function First_String_Type_Of
892 (Node : Project_Node_Id;
893 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
899 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
900 return In_Tree.Project_Nodes.Table (Node).Field3;
901 end First_String_Type_Of;
908 (Node : Project_Node_Id;
909 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
915 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
916 return In_Tree.Project_Nodes.Table (Node).Field1;
919 -----------------------
920 -- First_Variable_Of --
921 -----------------------
923 function First_Variable_Of
924 (Node : Project_Node_Id;
925 In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id
931 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
933 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
935 return In_Tree.Project_Nodes.Table (Node).Variables;
936 end First_Variable_Of;
938 --------------------------
939 -- First_With_Clause_Of --
940 --------------------------
942 function First_With_Clause_Of
943 (Node : Project_Node_Id;
944 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
950 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
951 return In_Tree.Project_Nodes.Table (Node).Field1;
952 end First_With_Clause_Of;
954 ------------------------
955 -- Follows_Empty_Line --
956 ------------------------
958 function Follows_Empty_Line
959 (Node : Project_Node_Id;
960 In_Tree : Project_Node_Tree_Ref) return Boolean is
965 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
966 return In_Tree.Project_Nodes.Table (Node).Flag1;
967 end Follows_Empty_Line;
973 function Hash (N : Project_Node_Id) return Header_Num is
975 return Header_Num (N mod Project_Node_Id (Header_Num'Last));
982 procedure Initialize (Tree : Project_Node_Tree_Ref) is
984 Project_Node_Table.Init (Tree.Project_Nodes);
985 Projects_Htable.Reset (Tree.Projects_HT);
992 procedure Free (Prj : in out Project_Node_Tree_Ref) is
993 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
994 (Project_Node_Tree_Data, Project_Node_Tree_Ref);
997 Project_Node_Table.Free (Prj.Project_Nodes);
998 Projects_Htable.Reset (Prj.Projects_HT);
999 Unchecked_Free (Prj);
1003 -------------------------------
1004 -- Is_Followed_By_Empty_Line --
1005 -------------------------------
1007 function Is_Followed_By_Empty_Line
1008 (Node : Project_Node_Id;
1009 In_Tree : Project_Node_Tree_Ref) return Boolean
1015 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1016 return In_Tree.Project_Nodes.Table (Node).Flag2;
1017 end Is_Followed_By_Empty_Line;
1019 ----------------------
1020 -- Is_Extending_All --
1021 ----------------------
1023 function Is_Extending_All
1024 (Node : Project_Node_Id;
1025 In_Tree : Project_Node_Tree_Ref) return Boolean is
1030 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1032 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1033 return In_Tree.Project_Nodes.Table (Node).Flag2;
1034 end Is_Extending_All;
1036 -------------------------
1037 -- Is_Not_Last_In_List --
1038 -------------------------
1040 function Is_Not_Last_In_List
1041 (Node : Project_Node_Id;
1042 In_Tree : Project_Node_Tree_Ref) return Boolean is
1047 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1048 return In_Tree.Project_Nodes.Table (Node).Flag1;
1049 end Is_Not_Last_In_List;
1051 -------------------------------------
1052 -- Imported_Or_Extended_Project_Of --
1053 -------------------------------------
1055 function Imported_Or_Extended_Project_Of
1056 (Project : Project_Node_Id;
1057 In_Tree : Project_Node_Tree_Ref;
1058 With_Name : Name_Id) return Project_Node_Id
1060 With_Clause : Project_Node_Id :=
1061 First_With_Clause_Of (Project, In_Tree);
1062 Result : Project_Node_Id := Empty_Node;
1065 -- First check all the imported projects
1067 while Present (With_Clause) loop
1069 -- Only non limited imported project may be used as prefix
1070 -- of variable or attributes.
1072 Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree);
1073 exit when Present (Result)
1074 and then Name_Of (Result, In_Tree) = With_Name;
1075 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1078 -- If it is not an imported project, it might be an extended project
1080 if No (With_Clause) then
1085 (Project_Declaration_Of (Result, In_Tree), In_Tree);
1087 exit when No (Result)
1088 or else Name_Of (Result, In_Tree) = With_Name;
1093 end Imported_Or_Extended_Project_Of;
1100 (Node : Project_Node_Id;
1101 In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind is
1103 pragma Assert (Present (Node));
1104 return In_Tree.Project_Nodes.Table (Node).Kind;
1111 function Location_Of
1112 (Node : Project_Node_Id;
1113 In_Tree : Project_Node_Tree_Ref) return Source_Ptr is
1115 pragma Assert (Present (Node));
1116 return In_Tree.Project_Nodes.Table (Node).Location;
1124 (Node : Project_Node_Id;
1125 In_Tree : Project_Node_Tree_Ref) return Name_Id is
1127 pragma Assert (Present (Node));
1128 return In_Tree.Project_Nodes.Table (Node).Name;
1131 --------------------
1132 -- Next_Case_Item --
1133 --------------------
1135 function Next_Case_Item
1136 (Node : Project_Node_Id;
1137 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1143 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1144 return In_Tree.Project_Nodes.Table (Node).Field3;
1151 function Next_Comment
1152 (Node : Project_Node_Id;
1153 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is
1158 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1159 return In_Tree.Project_Nodes.Table (Node).Comments;
1162 ---------------------------
1163 -- Next_Declarative_Item --
1164 ---------------------------
1166 function Next_Declarative_Item
1167 (Node : Project_Node_Id;
1168 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1174 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1175 return In_Tree.Project_Nodes.Table (Node).Field2;
1176 end Next_Declarative_Item;
1178 -----------------------------
1179 -- Next_Expression_In_List --
1180 -----------------------------
1182 function Next_Expression_In_List
1183 (Node : Project_Node_Id;
1184 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1190 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
1191 return In_Tree.Project_Nodes.Table (Node).Field2;
1192 end Next_Expression_In_List;
1194 -------------------------
1195 -- Next_Literal_String --
1196 -------------------------
1198 function Next_Literal_String
1199 (Node : Project_Node_Id;
1200 In_Tree : Project_Node_Tree_Ref)
1201 return Project_Node_Id
1207 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
1208 return In_Tree.Project_Nodes.Table (Node).Field1;
1209 end Next_Literal_String;
1211 -----------------------------
1212 -- Next_Package_In_Project --
1213 -----------------------------
1215 function Next_Package_In_Project
1216 (Node : Project_Node_Id;
1217 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1223 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1224 return In_Tree.Project_Nodes.Table (Node).Field3;
1225 end Next_Package_In_Project;
1227 ----------------------
1228 -- Next_String_Type --
1229 ----------------------
1231 function Next_String_Type
1232 (Node : Project_Node_Id;
1233 In_Tree : Project_Node_Tree_Ref)
1234 return Project_Node_Id
1240 In_Tree.Project_Nodes.Table (Node).Kind =
1241 N_String_Type_Declaration);
1242 return In_Tree.Project_Nodes.Table (Node).Field2;
1243 end Next_String_Type;
1250 (Node : Project_Node_Id;
1251 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1257 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1258 return In_Tree.Project_Nodes.Table (Node).Field2;
1265 function Next_Variable
1266 (Node : Project_Node_Id;
1267 In_Tree : Project_Node_Tree_Ref)
1268 return Project_Node_Id
1274 (In_Tree.Project_Nodes.Table (Node).Kind =
1275 N_Typed_Variable_Declaration
1277 In_Tree.Project_Nodes.Table (Node).Kind =
1278 N_Variable_Declaration));
1280 return In_Tree.Project_Nodes.Table (Node).Field3;
1283 -------------------------
1284 -- Next_With_Clause_Of --
1285 -------------------------
1287 function Next_With_Clause_Of
1288 (Node : Project_Node_Id;
1289 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1295 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1296 return In_Tree.Project_Nodes.Table (Node).Field2;
1297 end Next_With_Clause_Of;
1303 function No (Node : Project_Node_Id) return Boolean is
1305 return Node = Empty_Node;
1308 ---------------------------------
1309 -- Non_Limited_Project_Node_Of --
1310 ---------------------------------
1312 function Non_Limited_Project_Node_Of
1313 (Node : Project_Node_Id;
1314 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1320 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1321 return In_Tree.Project_Nodes.Table (Node).Field3;
1322 end Non_Limited_Project_Node_Of;
1328 function Package_Id_Of
1329 (Node : Project_Node_Id;
1330 In_Tree : Project_Node_Tree_Ref) return Package_Node_Id
1336 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1337 return In_Tree.Project_Nodes.Table (Node).Pkg_Id;
1340 ---------------------
1341 -- Package_Node_Of --
1342 ---------------------
1344 function Package_Node_Of
1345 (Node : Project_Node_Id;
1346 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1352 (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1354 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1355 return In_Tree.Project_Nodes.Table (Node).Field2;
1356 end Package_Node_Of;
1362 function Path_Name_Of
1363 (Node : Project_Node_Id;
1364 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
1370 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1372 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1373 return In_Tree.Project_Nodes.Table (Node).Path_Name;
1380 function Present (Node : Project_Node_Id) return Boolean is
1382 return Node /= Empty_Node;
1385 ----------------------------
1386 -- Project_Declaration_Of --
1387 ----------------------------
1389 function Project_Declaration_Of
1390 (Node : Project_Node_Id;
1391 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1397 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1398 return In_Tree.Project_Nodes.Table (Node).Field2;
1399 end Project_Declaration_Of;
1401 --------------------------
1402 -- Project_Qualifier_Of --
1403 --------------------------
1405 function Project_Qualifier_Of
1406 (Node : Project_Node_Id;
1407 In_Tree : Project_Node_Tree_Ref) return Project_Qualifier
1413 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1414 return In_Tree.Project_Nodes.Table (Node).Qualifier;
1415 end Project_Qualifier_Of;
1417 -----------------------
1418 -- Parent_Project_Of --
1419 -----------------------
1421 function Parent_Project_Of
1422 (Node : Project_Node_Id;
1423 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1429 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1430 return In_Tree.Project_Nodes.Table (Node).Field4;
1431 end Parent_Project_Of;
1433 -------------------------------------------
1434 -- Project_File_Includes_Unkept_Comments --
1435 -------------------------------------------
1437 function Project_File_Includes_Unkept_Comments
1438 (Node : Project_Node_Id;
1439 In_Tree : Project_Node_Tree_Ref) return Boolean
1441 Declaration : constant Project_Node_Id :=
1442 Project_Declaration_Of (Node, In_Tree);
1444 return In_Tree.Project_Nodes.Table (Declaration).Flag1;
1445 end Project_File_Includes_Unkept_Comments;
1447 ---------------------
1448 -- Project_Node_Of --
1449 ---------------------
1451 function Project_Node_Of
1452 (Node : Project_Node_Id;
1453 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1459 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
1461 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1463 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1464 return In_Tree.Project_Nodes.Table (Node).Field1;
1465 end Project_Node_Of;
1467 -----------------------------------
1468 -- Project_Of_Renamed_Package_Of --
1469 -----------------------------------
1471 function Project_Of_Renamed_Package_Of
1472 (Node : Project_Node_Id;
1473 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1479 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1480 return In_Tree.Project_Nodes.Table (Node).Field1;
1481 end Project_Of_Renamed_Package_Of;
1483 --------------------------
1484 -- Remove_Next_End_Node --
1485 --------------------------
1487 procedure Remove_Next_End_Node is
1489 Next_End_Nodes.Decrement_Last;
1490 end Remove_Next_End_Node;
1496 procedure Reset_State is
1498 End_Of_Line_Node := Empty_Node;
1499 Previous_Line_Node := Empty_Node;
1500 Previous_End_Node := Empty_Node;
1501 Unkept_Comments := False;
1502 Comments.Set_Last (0);
1505 ----------------------
1506 -- Restore_And_Free --
1507 ----------------------
1509 procedure Restore_And_Free (S : in out Comment_State) is
1510 procedure Unchecked_Free is new
1511 Ada.Unchecked_Deallocation (Comment_Array, Comments_Ptr);
1514 End_Of_Line_Node := S.End_Of_Line_Node;
1515 Previous_Line_Node := S.Previous_Line_Node;
1516 Previous_End_Node := S.Previous_End_Node;
1517 Next_End_Nodes.Set_Last (0);
1518 Unkept_Comments := S.Unkept_Comments;
1520 Comments.Set_Last (0);
1522 for J in S.Comments'Range loop
1523 Comments.Increment_Last;
1524 Comments.Table (Comments.Last) := S.Comments (J);
1527 Unchecked_Free (S.Comments);
1528 end Restore_And_Free;
1534 procedure Save (S : out Comment_State) is
1535 Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last);
1538 for J in 1 .. Comments.Last loop
1539 Cmts (J) := Comments.Table (J);
1543 (End_Of_Line_Node => End_Of_Line_Node,
1544 Previous_Line_Node => Previous_Line_Node,
1545 Previous_End_Node => Previous_End_Node,
1546 Unkept_Comments => Unkept_Comments,
1554 procedure Scan (In_Tree : Project_Node_Tree_Ref) is
1555 Empty_Line : Boolean := False;
1558 -- If there are comments, then they will not be kept. Set the flag and
1559 -- clear the comments.
1561 if Comments.Last > 0 then
1562 Unkept_Comments := True;
1563 Comments.Set_Last (0);
1566 -- Loop until a token other that End_Of_Line or Comment is found
1569 Prj.Err.Scanner.Scan;
1572 when Tok_End_Of_Line =>
1573 if Prev_Token = Tok_End_Of_Line then
1576 if Comments.Last > 0 then
1577 Comments.Table (Comments.Last).Is_Followed_By_Empty_Line
1583 -- If this is a line comment, add it to the comment table
1585 if Prev_Token = Tok_End_Of_Line
1586 or else Prev_Token = No_Token
1588 Comments.Increment_Last;
1589 Comments.Table (Comments.Last) :=
1590 (Value => Comment_Id,
1591 Follows_Empty_Line => Empty_Line,
1592 Is_Followed_By_Empty_Line => False);
1594 -- Otherwise, it is an end of line comment. If there is
1595 -- an end of line node specified, associate the comment with
1598 elsif Present (End_Of_Line_Node) then
1600 Zones : constant Project_Node_Id :=
1601 Comment_Zones_Of (End_Of_Line_Node, In_Tree);
1603 In_Tree.Project_Nodes.Table (Zones).Value := Comment_Id;
1606 -- Otherwise, this end of line node cannot be kept
1609 Unkept_Comments := True;
1610 Comments.Set_Last (0);
1613 Empty_Line := False;
1616 -- If there are comments, where the first comment is not
1617 -- following an empty line, put the initial uninterrupted
1618 -- comment zone with the node of the preceding line (either
1619 -- a Previous_Line or a Previous_End node), if any.
1621 if Comments.Last > 0 and then
1622 not Comments.Table (1).Follows_Empty_Line then
1623 if Present (Previous_Line_Node) then
1625 (To => Previous_Line_Node,
1627 In_Tree => In_Tree);
1629 elsif Present (Previous_End_Node) then
1631 (To => Previous_End_Node,
1633 In_Tree => In_Tree);
1637 -- If there are still comments and the token is "end", then
1638 -- put these comments with the Next_End node, if any;
1639 -- otherwise, these comments cannot be kept. Always clear
1642 if Comments.Last > 0 and then Token = Tok_End then
1643 if Next_End_Nodes.Last > 0 then
1645 (To => Next_End_Nodes.Table (Next_End_Nodes.Last),
1646 Where => Before_End,
1647 In_Tree => In_Tree);
1650 Unkept_Comments := True;
1653 Comments.Set_Last (0);
1656 -- Reset the End_Of_Line, Previous_Line and Previous_End nodes
1657 -- so that they are not used again.
1659 End_Of_Line_Node := Empty_Node;
1660 Previous_Line_Node := Empty_Node;
1661 Previous_End_Node := Empty_Node;
1670 ------------------------------------
1671 -- Set_Associative_Array_Index_Of --
1672 ------------------------------------
1674 procedure Set_Associative_Array_Index_Of
1675 (Node : Project_Node_Id;
1676 In_Tree : Project_Node_Tree_Ref;
1683 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1685 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1686 In_Tree.Project_Nodes.Table (Node).Value := To;
1687 end Set_Associative_Array_Index_Of;
1689 --------------------------------
1690 -- Set_Associative_Package_Of --
1691 --------------------------------
1693 procedure Set_Associative_Package_Of
1694 (Node : Project_Node_Id;
1695 In_Tree : Project_Node_Tree_Ref;
1696 To : Project_Node_Id)
1702 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
1703 In_Tree.Project_Nodes.Table (Node).Field3 := To;
1704 end Set_Associative_Package_Of;
1706 --------------------------------
1707 -- Set_Associative_Project_Of --
1708 --------------------------------
1710 procedure Set_Associative_Project_Of
1711 (Node : Project_Node_Id;
1712 In_Tree : Project_Node_Tree_Ref;
1713 To : Project_Node_Id)
1719 (In_Tree.Project_Nodes.Table (Node).Kind =
1720 N_Attribute_Declaration));
1721 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1722 end Set_Associative_Project_Of;
1724 --------------------------
1725 -- Set_Case_Insensitive --
1726 --------------------------
1728 procedure Set_Case_Insensitive
1729 (Node : Project_Node_Id;
1730 In_Tree : Project_Node_Tree_Ref;
1737 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1739 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1740 In_Tree.Project_Nodes.Table (Node).Flag1 := To;
1741 end Set_Case_Insensitive;
1743 ------------------------------------
1744 -- Set_Case_Variable_Reference_Of --
1745 ------------------------------------
1747 procedure Set_Case_Variable_Reference_Of
1748 (Node : Project_Node_Id;
1749 In_Tree : Project_Node_Tree_Ref;
1750 To : Project_Node_Id)
1756 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1757 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1758 end Set_Case_Variable_Reference_Of;
1760 ---------------------------
1761 -- Set_Current_Item_Node --
1762 ---------------------------
1764 procedure Set_Current_Item_Node
1765 (Node : Project_Node_Id;
1766 In_Tree : Project_Node_Tree_Ref;
1767 To : Project_Node_Id)
1773 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1774 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1775 end Set_Current_Item_Node;
1777 ----------------------
1778 -- Set_Current_Term --
1779 ----------------------
1781 procedure Set_Current_Term
1782 (Node : Project_Node_Id;
1783 In_Tree : Project_Node_Tree_Ref;
1784 To : Project_Node_Id)
1790 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1791 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1792 end Set_Current_Term;
1794 ----------------------
1795 -- Set_Directory_Of --
1796 ----------------------
1798 procedure Set_Directory_Of
1799 (Node : Project_Node_Id;
1800 In_Tree : Project_Node_Tree_Ref;
1801 To : Path_Name_Type)
1807 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1808 In_Tree.Project_Nodes.Table (Node).Directory := To;
1809 end Set_Directory_Of;
1811 ---------------------
1812 -- Set_End_Of_Line --
1813 ---------------------
1815 procedure Set_End_Of_Line (To : Project_Node_Id) is
1817 End_Of_Line_Node := To;
1818 end Set_End_Of_Line;
1820 ----------------------------
1821 -- Set_Expression_Kind_Of --
1822 ----------------------------
1824 procedure Set_Expression_Kind_Of
1825 (Node : Project_Node_Id;
1826 In_Tree : Project_Node_Tree_Ref;
1833 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
1835 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1837 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
1839 In_Tree.Project_Nodes.Table (Node).Kind =
1840 N_Typed_Variable_Declaration
1842 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
1844 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
1846 In_Tree.Project_Nodes.Table (Node).Kind = N_Term
1848 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1850 In_Tree.Project_Nodes.Table (Node).Kind =
1851 N_Attribute_Reference));
1852 In_Tree.Project_Nodes.Table (Node).Expr_Kind := To;
1853 end Set_Expression_Kind_Of;
1855 -----------------------
1856 -- Set_Expression_Of --
1857 -----------------------
1859 procedure Set_Expression_Of
1860 (Node : Project_Node_Id;
1861 In_Tree : Project_Node_Tree_Ref;
1862 To : Project_Node_Id)
1868 (In_Tree.Project_Nodes.Table (Node).Kind =
1869 N_Attribute_Declaration
1871 In_Tree.Project_Nodes.Table (Node).Kind =
1872 N_Typed_Variable_Declaration
1874 In_Tree.Project_Nodes.Table (Node).Kind =
1875 N_Variable_Declaration));
1876 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1877 end Set_Expression_Of;
1879 -------------------------------
1880 -- Set_External_Reference_Of --
1881 -------------------------------
1883 procedure Set_External_Reference_Of
1884 (Node : Project_Node_Id;
1885 In_Tree : Project_Node_Tree_Ref;
1886 To : Project_Node_Id)
1892 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
1893 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1894 end Set_External_Reference_Of;
1896 -----------------------------
1897 -- Set_External_Default_Of --
1898 -----------------------------
1900 procedure Set_External_Default_Of
1901 (Node : Project_Node_Id;
1902 In_Tree : Project_Node_Tree_Ref;
1903 To : Project_Node_Id)
1909 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
1910 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1911 end Set_External_Default_Of;
1913 ----------------------------
1914 -- Set_First_Case_Item_Of --
1915 ----------------------------
1917 procedure Set_First_Case_Item_Of
1918 (Node : Project_Node_Id;
1919 In_Tree : Project_Node_Tree_Ref;
1920 To : Project_Node_Id)
1926 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1927 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1928 end Set_First_Case_Item_Of;
1930 -------------------------
1931 -- Set_First_Choice_Of --
1932 -------------------------
1934 procedure Set_First_Choice_Of
1935 (Node : Project_Node_Id;
1936 In_Tree : Project_Node_Tree_Ref;
1937 To : Project_Node_Id)
1943 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1944 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1945 end Set_First_Choice_Of;
1947 -----------------------------
1948 -- Set_First_Comment_After --
1949 -----------------------------
1951 procedure Set_First_Comment_After
1952 (Node : Project_Node_Id;
1953 In_Tree : Project_Node_Tree_Ref;
1954 To : Project_Node_Id)
1956 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1958 In_Tree.Project_Nodes.Table (Zone).Field2 := To;
1959 end Set_First_Comment_After;
1961 ---------------------------------
1962 -- Set_First_Comment_After_End --
1963 ---------------------------------
1965 procedure Set_First_Comment_After_End
1966 (Node : Project_Node_Id;
1967 In_Tree : Project_Node_Tree_Ref;
1968 To : Project_Node_Id)
1970 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1972 In_Tree.Project_Nodes.Table (Zone).Comments := To;
1973 end Set_First_Comment_After_End;
1975 ------------------------------
1976 -- Set_First_Comment_Before --
1977 ------------------------------
1979 procedure Set_First_Comment_Before
1980 (Node : Project_Node_Id;
1981 In_Tree : Project_Node_Tree_Ref;
1982 To : Project_Node_Id)
1985 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1987 In_Tree.Project_Nodes.Table (Zone).Field1 := To;
1988 end Set_First_Comment_Before;
1990 ----------------------------------
1991 -- Set_First_Comment_Before_End --
1992 ----------------------------------
1994 procedure Set_First_Comment_Before_End
1995 (Node : Project_Node_Id;
1996 In_Tree : Project_Node_Tree_Ref;
1997 To : Project_Node_Id)
1999 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2001 In_Tree.Project_Nodes.Table (Zone).Field2 := To;
2002 end Set_First_Comment_Before_End;
2004 ------------------------
2005 -- Set_Next_Case_Item --
2006 ------------------------
2008 procedure Set_Next_Case_Item
2009 (Node : Project_Node_Id;
2010 In_Tree : Project_Node_Tree_Ref;
2011 To : Project_Node_Id)
2017 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
2018 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2019 end Set_Next_Case_Item;
2021 ----------------------
2022 -- Set_Next_Comment --
2023 ----------------------
2025 procedure Set_Next_Comment
2026 (Node : Project_Node_Id;
2027 In_Tree : Project_Node_Tree_Ref;
2028 To : Project_Node_Id)
2034 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
2035 In_Tree.Project_Nodes.Table (Node).Comments := To;
2036 end Set_Next_Comment;
2038 -----------------------------------
2039 -- Set_First_Declarative_Item_Of --
2040 -----------------------------------
2042 procedure Set_First_Declarative_Item_Of
2043 (Node : Project_Node_Id;
2044 In_Tree : Project_Node_Tree_Ref;
2045 To : Project_Node_Id)
2051 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
2053 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
2055 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2057 if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
2058 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2060 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2062 end Set_First_Declarative_Item_Of;
2064 ----------------------------------
2065 -- Set_First_Expression_In_List --
2066 ----------------------------------
2068 procedure Set_First_Expression_In_List
2069 (Node : Project_Node_Id;
2070 In_Tree : Project_Node_Tree_Ref;
2071 To : Project_Node_Id)
2077 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
2078 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2079 end Set_First_Expression_In_List;
2081 ------------------------------
2082 -- Set_First_Literal_String --
2083 ------------------------------
2085 procedure Set_First_Literal_String
2086 (Node : Project_Node_Id;
2087 In_Tree : Project_Node_Tree_Ref;
2088 To : Project_Node_Id)
2094 In_Tree.Project_Nodes.Table (Node).Kind =
2095 N_String_Type_Declaration);
2096 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2097 end Set_First_Literal_String;
2099 --------------------------
2100 -- Set_First_Package_Of --
2101 --------------------------
2103 procedure Set_First_Package_Of
2104 (Node : Project_Node_Id;
2105 In_Tree : Project_Node_Tree_Ref;
2106 To : Package_Declaration_Id)
2112 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2113 In_Tree.Project_Nodes.Table (Node).Packages := To;
2114 end Set_First_Package_Of;
2116 ------------------------------
2117 -- Set_First_String_Type_Of --
2118 ------------------------------
2120 procedure Set_First_String_Type_Of
2121 (Node : Project_Node_Id;
2122 In_Tree : Project_Node_Tree_Ref;
2123 To : Project_Node_Id)
2129 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2130 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2131 end Set_First_String_Type_Of;
2133 --------------------
2134 -- Set_First_Term --
2135 --------------------
2137 procedure Set_First_Term
2138 (Node : Project_Node_Id;
2139 In_Tree : Project_Node_Tree_Ref;
2140 To : Project_Node_Id)
2146 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2147 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2150 ---------------------------
2151 -- Set_First_Variable_Of --
2152 ---------------------------
2154 procedure Set_First_Variable_Of
2155 (Node : Project_Node_Id;
2156 In_Tree : Project_Node_Tree_Ref;
2157 To : Variable_Node_Id)
2163 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2165 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2166 In_Tree.Project_Nodes.Table (Node).Variables := To;
2167 end Set_First_Variable_Of;
2169 ------------------------------
2170 -- Set_First_With_Clause_Of --
2171 ------------------------------
2173 procedure Set_First_With_Clause_Of
2174 (Node : Project_Node_Id;
2175 In_Tree : Project_Node_Tree_Ref;
2176 To : Project_Node_Id)
2182 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2183 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2184 end Set_First_With_Clause_Of;
2186 --------------------------
2187 -- Set_Is_Extending_All --
2188 --------------------------
2190 procedure Set_Is_Extending_All
2191 (Node : Project_Node_Id;
2192 In_Tree : Project_Node_Tree_Ref)
2198 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2200 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2201 In_Tree.Project_Nodes.Table (Node).Flag2 := True;
2202 end Set_Is_Extending_All;
2204 -----------------------------
2205 -- Set_Is_Not_Last_In_List --
2206 -----------------------------
2208 procedure Set_Is_Not_Last_In_List
2209 (Node : Project_Node_Id;
2210 In_Tree : Project_Node_Tree_Ref)
2216 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2217 In_Tree.Project_Nodes.Table (Node).Flag1 := True;
2218 end Set_Is_Not_Last_In_List;
2224 procedure Set_Kind_Of
2225 (Node : Project_Node_Id;
2226 In_Tree : Project_Node_Tree_Ref;
2227 To : Project_Node_Kind)
2230 pragma Assert (Present (Node));
2231 In_Tree.Project_Nodes.Table (Node).Kind := To;
2234 ---------------------
2235 -- Set_Location_Of --
2236 ---------------------
2238 procedure Set_Location_Of
2239 (Node : Project_Node_Id;
2240 In_Tree : Project_Node_Tree_Ref;
2244 pragma Assert (Present (Node));
2245 In_Tree.Project_Nodes.Table (Node).Location := To;
2246 end Set_Location_Of;
2248 -----------------------------
2249 -- Set_Extended_Project_Of --
2250 -----------------------------
2252 procedure Set_Extended_Project_Of
2253 (Node : Project_Node_Id;
2254 In_Tree : Project_Node_Tree_Ref;
2255 To : Project_Node_Id)
2261 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2262 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2263 end Set_Extended_Project_Of;
2265 ----------------------------------
2266 -- Set_Extended_Project_Path_Of --
2267 ----------------------------------
2269 procedure Set_Extended_Project_Path_Of
2270 (Node : Project_Node_Id;
2271 In_Tree : Project_Node_Tree_Ref;
2272 To : Path_Name_Type)
2278 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2279 In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To);
2280 end Set_Extended_Project_Path_Of;
2282 ------------------------------
2283 -- Set_Extending_Project_Of --
2284 ------------------------------
2286 procedure Set_Extending_Project_Of
2287 (Node : Project_Node_Id;
2288 In_Tree : Project_Node_Tree_Ref;
2289 To : Project_Node_Id)
2295 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2296 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2297 end Set_Extending_Project_Of;
2303 procedure Set_Name_Of
2304 (Node : Project_Node_Id;
2305 In_Tree : Project_Node_Tree_Ref;
2309 pragma Assert (Present (Node));
2310 In_Tree.Project_Nodes.Table (Node).Name := To;
2313 -------------------------------
2314 -- Set_Next_Declarative_Item --
2315 -------------------------------
2317 procedure Set_Next_Declarative_Item
2318 (Node : Project_Node_Id;
2319 In_Tree : Project_Node_Tree_Ref;
2320 To : Project_Node_Id)
2326 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
2327 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2328 end Set_Next_Declarative_Item;
2330 -----------------------
2331 -- Set_Next_End_Node --
2332 -----------------------
2334 procedure Set_Next_End_Node (To : Project_Node_Id) is
2336 Next_End_Nodes.Increment_Last;
2337 Next_End_Nodes.Table (Next_End_Nodes.Last) := To;
2338 end Set_Next_End_Node;
2340 ---------------------------------
2341 -- Set_Next_Expression_In_List --
2342 ---------------------------------
2344 procedure Set_Next_Expression_In_List
2345 (Node : Project_Node_Id;
2346 In_Tree : Project_Node_Tree_Ref;
2347 To : Project_Node_Id)
2353 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2354 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2355 end Set_Next_Expression_In_List;
2357 -----------------------------
2358 -- Set_Next_Literal_String --
2359 -----------------------------
2361 procedure Set_Next_Literal_String
2362 (Node : Project_Node_Id;
2363 In_Tree : Project_Node_Tree_Ref;
2364 To : Project_Node_Id)
2370 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
2371 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2372 end Set_Next_Literal_String;
2374 ---------------------------------
2375 -- Set_Next_Package_In_Project --
2376 ---------------------------------
2378 procedure Set_Next_Package_In_Project
2379 (Node : Project_Node_Id;
2380 In_Tree : Project_Node_Tree_Ref;
2381 To : Project_Node_Id)
2387 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2388 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2389 end Set_Next_Package_In_Project;
2391 --------------------------
2392 -- Set_Next_String_Type --
2393 --------------------------
2395 procedure Set_Next_String_Type
2396 (Node : Project_Node_Id;
2397 In_Tree : Project_Node_Tree_Ref;
2398 To : Project_Node_Id)
2404 In_Tree.Project_Nodes.Table (Node).Kind =
2405 N_String_Type_Declaration);
2406 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2407 end Set_Next_String_Type;
2413 procedure Set_Next_Term
2414 (Node : Project_Node_Id;
2415 In_Tree : Project_Node_Tree_Ref;
2416 To : Project_Node_Id)
2422 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
2423 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2426 -----------------------
2427 -- Set_Next_Variable --
2428 -----------------------
2430 procedure Set_Next_Variable
2431 (Node : Project_Node_Id;
2432 In_Tree : Project_Node_Tree_Ref;
2433 To : Project_Node_Id)
2439 (In_Tree.Project_Nodes.Table (Node).Kind =
2440 N_Typed_Variable_Declaration
2442 In_Tree.Project_Nodes.Table (Node).Kind =
2443 N_Variable_Declaration));
2444 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2445 end Set_Next_Variable;
2447 -----------------------------
2448 -- Set_Next_With_Clause_Of --
2449 -----------------------------
2451 procedure Set_Next_With_Clause_Of
2452 (Node : Project_Node_Id;
2453 In_Tree : Project_Node_Tree_Ref;
2454 To : Project_Node_Id)
2460 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2461 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2462 end Set_Next_With_Clause_Of;
2464 -----------------------
2465 -- Set_Package_Id_Of --
2466 -----------------------
2468 procedure Set_Package_Id_Of
2469 (Node : Project_Node_Id;
2470 In_Tree : Project_Node_Tree_Ref;
2471 To : Package_Node_Id)
2477 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2478 In_Tree.Project_Nodes.Table (Node).Pkg_Id := To;
2479 end Set_Package_Id_Of;
2481 -------------------------
2482 -- Set_Package_Node_Of --
2483 -------------------------
2485 procedure Set_Package_Node_Of
2486 (Node : Project_Node_Id;
2487 In_Tree : Project_Node_Tree_Ref;
2488 To : Project_Node_Id)
2494 (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2496 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2497 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2498 end Set_Package_Node_Of;
2500 ----------------------
2501 -- Set_Path_Name_Of --
2502 ----------------------
2504 procedure Set_Path_Name_Of
2505 (Node : Project_Node_Id;
2506 In_Tree : Project_Node_Tree_Ref;
2507 To : Path_Name_Type)
2513 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2515 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2516 In_Tree.Project_Nodes.Table (Node).Path_Name := To;
2517 end Set_Path_Name_Of;
2519 ---------------------------
2520 -- Set_Previous_End_Node --
2521 ---------------------------
2522 procedure Set_Previous_End_Node (To : Project_Node_Id) is
2524 Previous_End_Node := To;
2525 end Set_Previous_End_Node;
2527 ----------------------------
2528 -- Set_Previous_Line_Node --
2529 ----------------------------
2531 procedure Set_Previous_Line_Node (To : Project_Node_Id) is
2533 Previous_Line_Node := To;
2534 end Set_Previous_Line_Node;
2536 --------------------------------
2537 -- Set_Project_Declaration_Of --
2538 --------------------------------
2540 procedure Set_Project_Declaration_Of
2541 (Node : Project_Node_Id;
2542 In_Tree : Project_Node_Tree_Ref;
2543 To : Project_Node_Id)
2549 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2550 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2551 end Set_Project_Declaration_Of;
2553 ------------------------------
2554 -- Set_Project_Qualifier_Of --
2555 ------------------------------
2557 procedure Set_Project_Qualifier_Of
2558 (Node : Project_Node_Id;
2559 In_Tree : Project_Node_Tree_Ref;
2560 To : Project_Qualifier)
2565 and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2566 In_Tree.Project_Nodes.Table (Node).Qualifier := To;
2567 end Set_Project_Qualifier_Of;
2569 ---------------------------
2570 -- Set_Parent_Project_Of --
2571 ---------------------------
2573 procedure Set_Parent_Project_Of
2574 (Node : Project_Node_Id;
2575 In_Tree : Project_Node_Tree_Ref;
2576 To : Project_Node_Id)
2581 and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2582 In_Tree.Project_Nodes.Table (Node).Field4 := To;
2583 end Set_Parent_Project_Of;
2585 -----------------------------------------------
2586 -- Set_Project_File_Includes_Unkept_Comments --
2587 -----------------------------------------------
2589 procedure Set_Project_File_Includes_Unkept_Comments
2590 (Node : Project_Node_Id;
2591 In_Tree : Project_Node_Tree_Ref;
2594 Declaration : constant Project_Node_Id :=
2595 Project_Declaration_Of (Node, In_Tree);
2597 In_Tree.Project_Nodes.Table (Declaration).Flag1 := To;
2598 end Set_Project_File_Includes_Unkept_Comments;
2600 -------------------------
2601 -- Set_Project_Node_Of --
2602 -------------------------
2604 procedure Set_Project_Node_Of
2605 (Node : Project_Node_Id;
2606 In_Tree : Project_Node_Tree_Ref;
2607 To : Project_Node_Id;
2608 Limited_With : Boolean := False)
2614 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2616 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2618 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2619 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2621 if In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2622 and then not Limited_With
2624 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2626 end Set_Project_Node_Of;
2628 ---------------------------------------
2629 -- Set_Project_Of_Renamed_Package_Of --
2630 ---------------------------------------
2632 procedure Set_Project_Of_Renamed_Package_Of
2633 (Node : Project_Node_Id;
2634 In_Tree : Project_Node_Tree_Ref;
2635 To : Project_Node_Id)
2641 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2642 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2643 end Set_Project_Of_Renamed_Package_Of;
2645 -------------------------
2646 -- Set_Source_Index_Of --
2647 -------------------------
2649 procedure Set_Source_Index_Of
2650 (Node : Project_Node_Id;
2651 In_Tree : Project_Node_Tree_Ref;
2658 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2660 In_Tree.Project_Nodes.Table (Node).Kind =
2661 N_Attribute_Declaration));
2662 In_Tree.Project_Nodes.Table (Node).Src_Index := To;
2663 end Set_Source_Index_Of;
2665 ------------------------
2666 -- Set_String_Type_Of --
2667 ------------------------
2669 procedure Set_String_Type_Of
2670 (Node : Project_Node_Id;
2671 In_Tree : Project_Node_Tree_Ref;
2672 To : Project_Node_Id)
2678 (In_Tree.Project_Nodes.Table (Node).Kind =
2679 N_Variable_Reference
2681 In_Tree.Project_Nodes.Table (Node).Kind =
2682 N_Typed_Variable_Declaration)
2684 In_Tree.Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
2686 if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2687 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2689 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2691 end Set_String_Type_Of;
2693 -------------------------
2694 -- Set_String_Value_Of --
2695 -------------------------
2697 procedure Set_String_Value_Of
2698 (Node : Project_Node_Id;
2699 In_Tree : Project_Node_Tree_Ref;
2706 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2708 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2710 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2711 In_Tree.Project_Nodes.Table (Node).Value := To;
2712 end Set_String_Value_Of;
2714 ---------------------
2715 -- Source_Index_Of --
2716 ---------------------
2718 function Source_Index_Of
2719 (Node : Project_Node_Id;
2720 In_Tree : Project_Node_Tree_Ref) return Int
2726 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2728 In_Tree.Project_Nodes.Table (Node).Kind =
2729 N_Attribute_Declaration));
2730 return In_Tree.Project_Nodes.Table (Node).Src_Index;
2731 end Source_Index_Of;
2733 --------------------
2734 -- String_Type_Of --
2735 --------------------
2737 function String_Type_Of
2738 (Node : Project_Node_Id;
2739 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
2745 (In_Tree.Project_Nodes.Table (Node).Kind =
2746 N_Variable_Reference
2748 In_Tree.Project_Nodes.Table (Node).Kind =
2749 N_Typed_Variable_Declaration));
2751 if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2752 return In_Tree.Project_Nodes.Table (Node).Field3;
2754 return In_Tree.Project_Nodes.Table (Node).Field2;
2758 ---------------------
2759 -- String_Value_Of --
2760 ---------------------
2762 function String_Value_Of
2763 (Node : Project_Node_Id;
2764 In_Tree : Project_Node_Tree_Ref) return Name_Id
2770 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2772 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2774 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2775 return In_Tree.Project_Nodes.Table (Node).Value;
2776 end String_Value_Of;
2778 --------------------
2779 -- Value_Is_Valid --
2780 --------------------
2782 function Value_Is_Valid
2783 (For_Typed_Variable : Project_Node_Id;
2784 In_Tree : Project_Node_Tree_Ref;
2785 Value : Name_Id) return Boolean
2789 (Present (For_Typed_Variable)
2791 (In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind =
2792 N_Typed_Variable_Declaration));
2795 Current_String : Project_Node_Id :=
2796 First_Literal_String
2797 (String_Type_Of (For_Typed_Variable, In_Tree),
2801 while Present (Current_String)
2803 String_Value_Of (Current_String, In_Tree) /= Value
2806 Next_Literal_String (Current_String, In_Tree);
2809 return Present (Current_String);
2814 -------------------------------
2815 -- There_Are_Unkept_Comments --
2816 -------------------------------
2818 function There_Are_Unkept_Comments return Boolean is
2820 return Unkept_Comments;
2821 end There_Are_Unkept_Comments;
2823 --------------------
2824 -- Create_Project --
2825 --------------------
2827 function Create_Project
2828 (In_Tree : Project_Node_Tree_Ref;
2830 Full_Path : Path_Name_Type;
2831 Is_Config_File : Boolean := False) return Project_Node_Id
2833 Project : Project_Node_Id;
2834 Qualifier : Project_Qualifier := Unspecified;
2836 Project := Default_Project_Node (In_Tree, N_Project);
2837 Set_Name_Of (Project, In_Tree, Name);
2840 Path_Name_Type (Get_Directory (File_Name_Type (Full_Path))));
2841 Set_Path_Name_Of (Project, In_Tree, Full_Path);
2843 Set_Project_Declaration_Of
2845 Default_Project_Node (In_Tree, N_Project_Declaration));
2847 if Is_Config_File then
2848 Qualifier := Configuration;
2851 if not Is_Config_File then
2852 Prj.Tree.Tree_Private_Part.Projects_Htable.Set
2853 (In_Tree.Projects_HT,
2855 Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
2857 Canonical_Path => No_Path,
2860 Proj_Qualifier => Qualifier));
2870 procedure Add_At_End
2871 (Tree : Project_Node_Tree_Ref;
2872 Parent : Project_Node_Id;
2873 Expr : Project_Node_Id;
2874 Add_Before_First_Pkg : Boolean := False;
2875 Add_Before_First_Case : Boolean := False)
2877 Real_Parent : Project_Node_Id;
2878 New_Decl, Decl, Next : Project_Node_Id;
2879 Last, L : Project_Node_Id;
2882 if Kind_Of (Expr, Tree) /= N_Declarative_Item then
2883 New_Decl := Default_Project_Node (Tree, N_Declarative_Item);
2884 Set_Current_Item_Node (New_Decl, Tree, Expr);
2889 if Kind_Of (Parent, Tree) = N_Project then
2890 Real_Parent := Project_Declaration_Of (Parent, Tree);
2892 Real_Parent := Parent;
2895 Decl := First_Declarative_Item_Of (Real_Parent, Tree);
2897 if Decl = Empty_Node then
2898 Set_First_Declarative_Item_Of (Real_Parent, Tree, New_Decl);
2901 Next := Next_Declarative_Item (Decl, Tree);
2902 exit when Next = Empty_Node
2904 (Add_Before_First_Pkg
2905 and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
2906 N_Package_Declaration)
2908 (Add_Before_First_Case
2909 and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
2910 N_Case_Construction);
2914 -- In case Expr is in fact a range of declarative items
2918 L := Next_Declarative_Item (Last, Tree);
2919 exit when L = Empty_Node;
2923 -- In case Expr is in fact a range of declarative items
2927 L := Next_Declarative_Item (Last, Tree);
2928 exit when L = Empty_Node;
2932 Set_Next_Declarative_Item (Last, Tree, Next);
2933 Set_Next_Declarative_Item (Decl, Tree, New_Decl);
2937 ---------------------------
2938 -- Create_Literal_String --
2939 ---------------------------
2941 function Create_Literal_String
2942 (Str : Namet.Name_Id;
2943 Tree : Project_Node_Tree_Ref) return Project_Node_Id
2945 Node : Project_Node_Id;
2947 Node := Default_Project_Node (Tree, N_Literal_String, Prj.Single);
2948 Set_Next_Literal_String (Node, Tree, Empty_Node);
2949 Set_String_Value_Of (Node, Tree, Str);
2951 end Create_Literal_String;
2953 ---------------------------
2954 -- Enclose_In_Expression --
2955 ---------------------------
2957 function Enclose_In_Expression
2958 (Node : Project_Node_Id;
2959 Tree : Project_Node_Tree_Ref) return Project_Node_Id
2961 Expr : constant Project_Node_Id :=
2962 Default_Project_Node (Tree, N_Expression, Single);
2964 Set_First_Term (Expr, Tree, Default_Project_Node (Tree, N_Term, Single));
2965 Set_Current_Term (First_Term (Expr, Tree), Tree, Node);
2967 end Enclose_In_Expression;
2969 --------------------
2970 -- Create_Package --
2971 --------------------
2973 function Create_Package
2974 (Tree : Project_Node_Tree_Ref;
2975 Project : Project_Node_Id;
2976 Pkg : String) return Project_Node_Id
2978 Pack : Project_Node_Id;
2982 Name_Len := Pkg'Length;
2983 Name_Buffer (1 .. Name_Len) := Pkg;
2986 -- Check if the package already exists
2988 Pack := First_Package_Of (Project, Tree);
2989 while Pack /= Empty_Node loop
2990 if Prj.Tree.Name_Of (Pack, Tree) = N then
2994 Pack := Next_Package_In_Project (Pack, Tree);
2997 -- Create the package and add it to the declarative item
2999 Pack := Default_Project_Node (Tree, N_Package_Declaration);
3000 Set_Name_Of (Pack, Tree, N);
3002 -- Find the correct package id to use
3004 Set_Package_Id_Of (Pack, Tree, Package_Node_Id_Of (N));
3006 -- Add it to the list of packages
3008 Set_Next_Package_In_Project
3009 (Pack, Tree, First_Package_Of (Project, Tree));
3010 Set_First_Package_Of (Project, Tree, Pack);
3012 Add_At_End (Tree, Project_Declaration_Of (Project, Tree), Pack);
3018 -- Create_Attribute --
3019 ----------------------
3021 function Create_Attribute
3022 (Tree : Project_Node_Tree_Ref;
3023 Prj_Or_Pkg : Project_Node_Id;
3025 Index_Name : Name_Id := No_Name;
3026 Kind : Variable_Kind := List;
3027 At_Index : Integer := 0) return Project_Node_Id
3029 Node : constant Project_Node_Id :=
3030 Default_Project_Node (Tree, N_Attribute_Declaration, Kind);
3032 Case_Insensitive : Boolean;
3034 Pkg : Package_Node_Id;
3035 Start_At : Attribute_Node_Id;
3038 Set_Name_Of (Node, Tree, Name);
3040 if At_Index /= 0 then
3041 Set_Source_Index_Of (Node, Tree, To => Int (At_Index));
3044 if Index_Name /= No_Name then
3045 Set_Associative_Array_Index_Of (Node, Tree, Index_Name);
3048 if Prj_Or_Pkg /= Empty_Node then
3049 Add_At_End (Tree, Prj_Or_Pkg, Node);
3052 -- Find out the case sensitivity of the attribute
3054 if Prj_Or_Pkg /= Empty_Node
3055 and then Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration
3057 Pkg := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree));
3058 Start_At := First_Attribute_Of (Pkg);
3060 Start_At := Attribute_First;
3063 Start_At := Attribute_Node_Id_Of (Name, Start_At);
3065 Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array;
3066 Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive;
3069 end Create_Attribute;