1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2010, 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 Osint; use Osint;
27 with Prj.Env; use Prj.Env;
30 with Ada.Unchecked_Deallocation;
32 package body Prj.Tree is
34 Node_With_Comments : constant array (Project_Node_Kind) of Boolean :=
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,
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,
53 N_Comment_Zones => 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,
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
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.
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;
102 and then In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
104 Zone := In_Tree.Project_Nodes.Table (To).Comments;
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,
123 Path_Name => No_Path,
125 Field1 => Empty_Node,
126 Field2 => Empty_Node,
127 Field3 => Empty_Node,
128 Field4 => Empty_Node,
131 Comments => Empty_Node);
133 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
134 In_Tree.Project_Nodes.Table (To).Comments := Zone;
137 if Where = End_Of_Line then
138 In_Tree.Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
141 -- Get each comments in the Comments table and link them to node To
143 for J in 1 .. Comments.Last loop
145 -- Create new N_Comment node
147 if (Where = After or else Where = After_End) and then
148 Token /= Tok_EOF and then
149 Comments.Table (J).Follows_Empty_Line
151 Comments.Table (1 .. Comments.Last - J + 1) :=
152 Comments.Table (J .. Comments.Last);
153 Comments.Set_Last (Comments.Last - J + 1);
157 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
158 In_Tree.Project_Nodes.Table
159 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
161 Qualifier => Unspecified,
162 Expr_Kind => Undefined,
163 Flag1 => Comments.Table (J).Follows_Empty_Line,
165 Comments.Table (J).Is_Followed_By_Empty_Line,
166 Location => No_Location,
167 Directory => No_Path,
168 Variables => Empty_Node,
169 Packages => Empty_Node,
170 Pkg_Id => Empty_Package,
173 Path_Name => No_Path,
174 Value => Comments.Table (J).Value,
175 Field1 => Empty_Node,
176 Field2 => Empty_Node,
177 Field3 => Empty_Node,
178 Field4 => Empty_Node,
179 Comments => Empty_Node);
181 -- If this is the first comment, put it in the right field of
184 if No (Previous) then
187 In_Tree.Project_Nodes.Table (Zone).Field1 :=
188 Project_Node_Table.Last (In_Tree.Project_Nodes);
191 In_Tree.Project_Nodes.Table (Zone).Field2 :=
192 Project_Node_Table.Last (In_Tree.Project_Nodes);
195 In_Tree.Project_Nodes.Table (Zone).Field3 :=
196 Project_Node_Table.Last (In_Tree.Project_Nodes);
199 In_Tree.Project_Nodes.Table (Zone).Comments :=
200 Project_Node_Table.Last (In_Tree.Project_Nodes);
207 -- When it is not the first, link it to the previous one
209 In_Tree.Project_Nodes.Table (Previous).Comments :=
210 Project_Node_Table.Last (In_Tree.Project_Nodes);
213 -- This node becomes the previous one for the next comment, if
216 Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
220 -- Empty the Comments table, so that there is no risk to link the same
221 -- comments to another node.
223 Comments.Set_Last (0);
226 --------------------------------
227 -- Associative_Array_Index_Of --
228 --------------------------------
230 function Associative_Array_Index_Of
231 (Node : Project_Node_Id;
232 In_Tree : Project_Node_Tree_Ref) return Name_Id
238 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
240 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
241 return In_Tree.Project_Nodes.Table (Node).Value;
242 end Associative_Array_Index_Of;
244 ----------------------------
245 -- Associative_Package_Of --
246 ----------------------------
248 function Associative_Package_Of
249 (Node : Project_Node_Id;
250 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
256 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
257 return In_Tree.Project_Nodes.Table (Node).Field3;
258 end Associative_Package_Of;
260 ----------------------------
261 -- Associative_Project_Of --
262 ----------------------------
264 function Associative_Project_Of
265 (Node : Project_Node_Id;
266 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
272 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
273 return In_Tree.Project_Nodes.Table (Node).Field2;
274 end Associative_Project_Of;
276 ----------------------
277 -- Case_Insensitive --
278 ----------------------
280 function Case_Insensitive
281 (Node : Project_Node_Id;
282 In_Tree : Project_Node_Tree_Ref) return Boolean is
287 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
289 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
290 return In_Tree.Project_Nodes.Table (Node).Flag1;
291 end Case_Insensitive;
293 --------------------------------
294 -- Case_Variable_Reference_Of --
295 --------------------------------
297 function Case_Variable_Reference_Of
298 (Node : Project_Node_Id;
299 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
305 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
306 return In_Tree.Project_Nodes.Table (Node).Field1;
307 end Case_Variable_Reference_Of;
309 ----------------------
310 -- Comment_Zones_Of --
311 ----------------------
313 function Comment_Zones_Of
314 (Node : Project_Node_Id;
315 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
317 Zone : Project_Node_Id;
320 pragma Assert (Present (Node));
321 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
323 -- If there is not already an N_Comment_Zones associated, create a new
324 -- one and associate it with node Node.
327 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
328 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
329 In_Tree.Project_Nodes.Table (Zone) :=
330 (Kind => N_Comment_Zones,
331 Qualifier => Unspecified,
332 Location => No_Location,
333 Directory => No_Path,
334 Expr_Kind => Undefined,
335 Variables => Empty_Node,
336 Packages => Empty_Node,
337 Pkg_Id => Empty_Package,
340 Path_Name => No_Path,
342 Field1 => Empty_Node,
343 Field2 => Empty_Node,
344 Field3 => Empty_Node,
345 Field4 => Empty_Node,
348 Comments => Empty_Node);
349 In_Tree.Project_Nodes.Table (Node).Comments := Zone;
353 end Comment_Zones_Of;
355 -----------------------
356 -- Current_Item_Node --
357 -----------------------
359 function Current_Item_Node
360 (Node : Project_Node_Id;
361 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
367 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
368 return In_Tree.Project_Nodes.Table (Node).Field1;
369 end Current_Item_Node;
375 function Current_Term
376 (Node : Project_Node_Id;
377 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
383 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
384 return In_Tree.Project_Nodes.Table (Node).Field1;
387 --------------------------
388 -- Default_Project_Node --
389 --------------------------
391 function Default_Project_Node
392 (In_Tree : Project_Node_Tree_Ref;
393 Of_Kind : Project_Node_Kind;
394 And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id
396 Result : Project_Node_Id;
397 Zone : Project_Node_Id;
398 Previous : Project_Node_Id;
401 -- Create new node with specified kind and expression kind
403 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
404 In_Tree.Project_Nodes.Table
405 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
407 Qualifier => Unspecified,
408 Location => No_Location,
409 Directory => No_Path,
410 Expr_Kind => And_Expr_Kind,
411 Variables => Empty_Node,
412 Packages => Empty_Node,
413 Pkg_Id => Empty_Package,
416 Path_Name => No_Path,
418 Field1 => Empty_Node,
419 Field2 => Empty_Node,
420 Field3 => Empty_Node,
421 Field4 => Empty_Node,
424 Comments => Empty_Node);
426 -- Save the new node for the returned value
428 Result := Project_Node_Table.Last (In_Tree.Project_Nodes);
430 if Comments.Last > 0 then
432 -- If this is not a node with comments, then set the flag
434 if not Node_With_Comments (Of_Kind) then
435 Unkept_Comments := True;
437 elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then
439 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
440 In_Tree.Project_Nodes.Table
441 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
442 (Kind => N_Comment_Zones,
443 Qualifier => Unspecified,
444 Expr_Kind => Undefined,
445 Location => No_Location,
446 Directory => No_Path,
447 Variables => Empty_Node,
448 Packages => Empty_Node,
449 Pkg_Id => Empty_Package,
452 Path_Name => No_Path,
454 Field1 => Empty_Node,
455 Field2 => Empty_Node,
456 Field3 => Empty_Node,
457 Field4 => Empty_Node,
460 Comments => Empty_Node);
462 Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
463 In_Tree.Project_Nodes.Table (Result).Comments := Zone;
464 Previous := Empty_Node;
466 for J in 1 .. Comments.Last loop
468 -- Create a new N_Comment node
470 Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
471 In_Tree.Project_Nodes.Table
472 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
474 Qualifier => Unspecified,
475 Expr_Kind => Undefined,
476 Flag1 => Comments.Table (J).Follows_Empty_Line,
478 Comments.Table (J).Is_Followed_By_Empty_Line,
479 Location => No_Location,
480 Directory => No_Path,
481 Variables => Empty_Node,
482 Packages => Empty_Node,
483 Pkg_Id => Empty_Package,
486 Path_Name => No_Path,
487 Value => Comments.Table (J).Value,
488 Field1 => Empty_Node,
489 Field2 => Empty_Node,
490 Field3 => Empty_Node,
491 Field4 => Empty_Node,
492 Comments => Empty_Node);
494 -- Link it to the N_Comment_Zones node, if it is the first,
495 -- otherwise to the previous one.
497 if No (Previous) then
498 In_Tree.Project_Nodes.Table (Zone).Field1 :=
499 Project_Node_Table.Last (In_Tree.Project_Nodes);
502 In_Tree.Project_Nodes.Table (Previous).Comments :=
503 Project_Node_Table.Last (In_Tree.Project_Nodes);
506 -- This new node will be the previous one for the next
507 -- N_Comment node, if there is one.
509 Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
512 -- Empty the Comments table after all comments have been processed
514 Comments.Set_Last (0);
519 end Default_Project_Node;
525 function Directory_Of
526 (Node : Project_Node_Id;
527 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is
532 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
533 return In_Tree.Project_Nodes.Table (Node).Directory;
536 -------------------------
537 -- End_Of_Line_Comment --
538 -------------------------
540 function End_Of_Line_Comment
541 (Node : Project_Node_Id;
542 In_Tree : Project_Node_Tree_Ref) return Name_Id is
543 Zone : Project_Node_Id := Empty_Node;
546 pragma Assert (Present (Node));
547 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
552 return In_Tree.Project_Nodes.Table (Zone).Value;
554 end End_Of_Line_Comment;
556 ------------------------
557 -- Expression_Kind_Of --
558 ------------------------
560 function Expression_Kind_Of
561 (Node : Project_Node_Id;
562 In_Tree : Project_Node_Tree_Ref) return Variable_Kind
567 and then -- should use Nkind_In here ??? why not???
568 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
570 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
572 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
574 In_Tree.Project_Nodes.Table (Node).Kind =
575 N_Typed_Variable_Declaration
577 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
579 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
581 In_Tree.Project_Nodes.Table (Node).Kind = N_Term
583 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
585 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference
587 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value));
588 return In_Tree.Project_Nodes.Table (Node).Expr_Kind;
589 end Expression_Kind_Of;
595 function Expression_Of
596 (Node : Project_Node_Id;
597 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
603 (In_Tree.Project_Nodes.Table (Node).Kind =
604 N_Attribute_Declaration
606 In_Tree.Project_Nodes.Table (Node).Kind =
607 N_Typed_Variable_Declaration
609 In_Tree.Project_Nodes.Table (Node).Kind =
610 N_Variable_Declaration));
612 return In_Tree.Project_Nodes.Table (Node).Field1;
615 -------------------------
616 -- Extended_Project_Of --
617 -------------------------
619 function Extended_Project_Of
620 (Node : Project_Node_Id;
621 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
627 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
628 return In_Tree.Project_Nodes.Table (Node).Field2;
629 end Extended_Project_Of;
631 ------------------------------
632 -- Extended_Project_Path_Of --
633 ------------------------------
635 function Extended_Project_Path_Of
636 (Node : Project_Node_Id;
637 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
643 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
644 return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value);
645 end Extended_Project_Path_Of;
647 --------------------------
648 -- Extending_Project_Of --
649 --------------------------
650 function Extending_Project_Of
651 (Node : Project_Node_Id;
652 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
658 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
659 return In_Tree.Project_Nodes.Table (Node).Field3;
660 end Extending_Project_Of;
662 ---------------------------
663 -- External_Reference_Of --
664 ---------------------------
666 function External_Reference_Of
667 (Node : Project_Node_Id;
668 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
674 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
675 return In_Tree.Project_Nodes.Table (Node).Field1;
676 end External_Reference_Of;
678 -------------------------
679 -- External_Default_Of --
680 -------------------------
682 function External_Default_Of
683 (Node : Project_Node_Id;
684 In_Tree : Project_Node_Tree_Ref)
685 return Project_Node_Id
691 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
692 return In_Tree.Project_Nodes.Table (Node).Field2;
693 end External_Default_Of;
695 ------------------------
696 -- First_Case_Item_Of --
697 ------------------------
699 function First_Case_Item_Of
700 (Node : Project_Node_Id;
701 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
707 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
708 return In_Tree.Project_Nodes.Table (Node).Field2;
709 end First_Case_Item_Of;
711 ---------------------
712 -- First_Choice_Of --
713 ---------------------
715 function First_Choice_Of
716 (Node : Project_Node_Id;
717 In_Tree : Project_Node_Tree_Ref)
718 return Project_Node_Id
724 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
725 return In_Tree.Project_Nodes.Table (Node).Field1;
728 -------------------------
729 -- First_Comment_After --
730 -------------------------
732 function First_Comment_After
733 (Node : Project_Node_Id;
734 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
736 Zone : Project_Node_Id := Empty_Node;
738 pragma Assert (Present (Node));
739 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
745 return In_Tree.Project_Nodes.Table (Zone).Field2;
747 end First_Comment_After;
749 -----------------------------
750 -- First_Comment_After_End --
751 -----------------------------
753 function First_Comment_After_End
754 (Node : Project_Node_Id;
755 In_Tree : Project_Node_Tree_Ref)
756 return Project_Node_Id
758 Zone : Project_Node_Id := Empty_Node;
761 pragma Assert (Present (Node));
762 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
768 return In_Tree.Project_Nodes.Table (Zone).Comments;
770 end First_Comment_After_End;
772 --------------------------
773 -- First_Comment_Before --
774 --------------------------
776 function First_Comment_Before
777 (Node : Project_Node_Id;
778 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
780 Zone : Project_Node_Id := Empty_Node;
783 pragma Assert (Present (Node));
784 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
790 return In_Tree.Project_Nodes.Table (Zone).Field1;
792 end First_Comment_Before;
794 ------------------------------
795 -- First_Comment_Before_End --
796 ------------------------------
798 function First_Comment_Before_End
799 (Node : Project_Node_Id;
800 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
802 Zone : Project_Node_Id := Empty_Node;
805 pragma Assert (Present (Node));
806 Zone := In_Tree.Project_Nodes.Table (Node).Comments;
812 return In_Tree.Project_Nodes.Table (Zone).Field3;
814 end First_Comment_Before_End;
816 -------------------------------
817 -- First_Declarative_Item_Of --
818 -------------------------------
820 function First_Declarative_Item_Of
821 (Node : Project_Node_Id;
822 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
828 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
830 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
832 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
834 if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
835 return In_Tree.Project_Nodes.Table (Node).Field1;
837 return In_Tree.Project_Nodes.Table (Node).Field2;
839 end First_Declarative_Item_Of;
841 ------------------------------
842 -- First_Expression_In_List --
843 ------------------------------
845 function First_Expression_In_List
846 (Node : Project_Node_Id;
847 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
853 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
854 return In_Tree.Project_Nodes.Table (Node).Field1;
855 end First_Expression_In_List;
857 --------------------------
858 -- First_Literal_String --
859 --------------------------
861 function First_Literal_String
862 (Node : Project_Node_Id;
863 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
869 In_Tree.Project_Nodes.Table (Node).Kind =
870 N_String_Type_Declaration);
871 return In_Tree.Project_Nodes.Table (Node).Field1;
872 end First_Literal_String;
874 ----------------------
875 -- First_Package_Of --
876 ----------------------
878 function First_Package_Of
879 (Node : Project_Node_Id;
880 In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id
886 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
887 return In_Tree.Project_Nodes.Table (Node).Packages;
888 end First_Package_Of;
890 --------------------------
891 -- First_String_Type_Of --
892 --------------------------
894 function First_String_Type_Of
895 (Node : Project_Node_Id;
896 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
902 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
903 return In_Tree.Project_Nodes.Table (Node).Field3;
904 end First_String_Type_Of;
911 (Node : Project_Node_Id;
912 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
918 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
919 return In_Tree.Project_Nodes.Table (Node).Field1;
922 -----------------------
923 -- First_Variable_Of --
924 -----------------------
926 function First_Variable_Of
927 (Node : Project_Node_Id;
928 In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id
934 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
936 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
938 return In_Tree.Project_Nodes.Table (Node).Variables;
939 end First_Variable_Of;
941 --------------------------
942 -- First_With_Clause_Of --
943 --------------------------
945 function First_With_Clause_Of
946 (Node : Project_Node_Id;
947 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
953 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
954 return In_Tree.Project_Nodes.Table (Node).Field1;
955 end First_With_Clause_Of;
957 ------------------------
958 -- Follows_Empty_Line --
959 ------------------------
961 function Follows_Empty_Line
962 (Node : Project_Node_Id;
963 In_Tree : Project_Node_Tree_Ref) return Boolean is
968 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
969 return In_Tree.Project_Nodes.Table (Node).Flag1;
970 end Follows_Empty_Line;
976 function Hash (N : Project_Node_Id) return Header_Num is
978 return Header_Num (N mod Project_Node_Id (Header_Num'Last));
985 procedure Initialize (Tree : Project_Node_Tree_Ref) is
987 Project_Node_Table.Init (Tree.Project_Nodes);
988 Projects_Htable.Reset (Tree.Projects_HT);
990 -- Do not reset the external references, in case we are reloading a
991 -- project, since we want to preserve the current environment
992 -- Name_To_Name_HTable.Reset (Tree.External_References);
999 procedure Free (Proj : in out Project_Node_Tree_Ref) is
1000 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1001 (Project_Node_Tree_Data, Project_Node_Tree_Ref);
1003 if Proj /= null then
1004 Project_Node_Table.Free (Proj.Project_Nodes);
1005 Projects_Htable.Reset (Proj.Projects_HT);
1006 Name_To_Name_HTable.Reset (Proj.External_References);
1007 Free (Proj.Project_Path);
1008 Unchecked_Free (Proj);
1012 -------------------------------
1013 -- Is_Followed_By_Empty_Line --
1014 -------------------------------
1016 function Is_Followed_By_Empty_Line
1017 (Node : Project_Node_Id;
1018 In_Tree : Project_Node_Tree_Ref) return Boolean
1024 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1025 return In_Tree.Project_Nodes.Table (Node).Flag2;
1026 end Is_Followed_By_Empty_Line;
1028 ----------------------
1029 -- Is_Extending_All --
1030 ----------------------
1032 function Is_Extending_All
1033 (Node : Project_Node_Id;
1034 In_Tree : Project_Node_Tree_Ref) return Boolean is
1039 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1041 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1042 return In_Tree.Project_Nodes.Table (Node).Flag2;
1043 end Is_Extending_All;
1045 -------------------------
1046 -- Is_Not_Last_In_List --
1047 -------------------------
1049 function Is_Not_Last_In_List
1050 (Node : Project_Node_Id;
1051 In_Tree : Project_Node_Tree_Ref) return Boolean is
1056 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1057 return In_Tree.Project_Nodes.Table (Node).Flag1;
1058 end Is_Not_Last_In_List;
1060 -------------------------------------
1061 -- Imported_Or_Extended_Project_Of --
1062 -------------------------------------
1064 function Imported_Or_Extended_Project_Of
1065 (Project : Project_Node_Id;
1066 In_Tree : Project_Node_Tree_Ref;
1067 With_Name : Name_Id) return Project_Node_Id
1069 With_Clause : Project_Node_Id :=
1070 First_With_Clause_Of (Project, In_Tree);
1071 Result : Project_Node_Id := Empty_Node;
1074 -- First check all the imported projects
1076 while Present (With_Clause) loop
1078 -- Only non limited imported project may be used as prefix
1079 -- of variable or attributes.
1081 Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree);
1082 exit when Present (Result)
1083 and then Name_Of (Result, In_Tree) = With_Name;
1084 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1087 -- If it is not an imported project, it might be an extended project
1089 if No (With_Clause) then
1094 (Project_Declaration_Of (Result, In_Tree), In_Tree);
1096 exit when No (Result)
1097 or else Name_Of (Result, In_Tree) = With_Name;
1102 end Imported_Or_Extended_Project_Of;
1109 (Node : Project_Node_Id;
1110 In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind is
1112 pragma Assert (Present (Node));
1113 return In_Tree.Project_Nodes.Table (Node).Kind;
1120 function Location_Of
1121 (Node : Project_Node_Id;
1122 In_Tree : Project_Node_Tree_Ref) return Source_Ptr is
1124 pragma Assert (Present (Node));
1125 return In_Tree.Project_Nodes.Table (Node).Location;
1133 (Node : Project_Node_Id;
1134 In_Tree : Project_Node_Tree_Ref) return Name_Id is
1136 pragma Assert (Present (Node));
1137 return In_Tree.Project_Nodes.Table (Node).Name;
1140 --------------------
1141 -- Next_Case_Item --
1142 --------------------
1144 function Next_Case_Item
1145 (Node : Project_Node_Id;
1146 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1152 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1153 return In_Tree.Project_Nodes.Table (Node).Field3;
1160 function Next_Comment
1161 (Node : Project_Node_Id;
1162 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is
1167 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1168 return In_Tree.Project_Nodes.Table (Node).Comments;
1171 ---------------------------
1172 -- Next_Declarative_Item --
1173 ---------------------------
1175 function Next_Declarative_Item
1176 (Node : Project_Node_Id;
1177 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1183 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1184 return In_Tree.Project_Nodes.Table (Node).Field2;
1185 end Next_Declarative_Item;
1187 -----------------------------
1188 -- Next_Expression_In_List --
1189 -----------------------------
1191 function Next_Expression_In_List
1192 (Node : Project_Node_Id;
1193 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1199 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
1200 return In_Tree.Project_Nodes.Table (Node).Field2;
1201 end Next_Expression_In_List;
1203 -------------------------
1204 -- Next_Literal_String --
1205 -------------------------
1207 function Next_Literal_String
1208 (Node : Project_Node_Id;
1209 In_Tree : Project_Node_Tree_Ref)
1210 return Project_Node_Id
1216 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
1217 return In_Tree.Project_Nodes.Table (Node).Field1;
1218 end Next_Literal_String;
1220 -----------------------------
1221 -- Next_Package_In_Project --
1222 -----------------------------
1224 function Next_Package_In_Project
1225 (Node : Project_Node_Id;
1226 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1232 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1233 return In_Tree.Project_Nodes.Table (Node).Field3;
1234 end Next_Package_In_Project;
1236 ----------------------
1237 -- Next_String_Type --
1238 ----------------------
1240 function Next_String_Type
1241 (Node : Project_Node_Id;
1242 In_Tree : Project_Node_Tree_Ref)
1243 return Project_Node_Id
1249 In_Tree.Project_Nodes.Table (Node).Kind =
1250 N_String_Type_Declaration);
1251 return In_Tree.Project_Nodes.Table (Node).Field2;
1252 end Next_String_Type;
1259 (Node : Project_Node_Id;
1260 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1266 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1267 return In_Tree.Project_Nodes.Table (Node).Field2;
1274 function Next_Variable
1275 (Node : Project_Node_Id;
1276 In_Tree : Project_Node_Tree_Ref)
1277 return Project_Node_Id
1283 (In_Tree.Project_Nodes.Table (Node).Kind =
1284 N_Typed_Variable_Declaration
1286 In_Tree.Project_Nodes.Table (Node).Kind =
1287 N_Variable_Declaration));
1289 return In_Tree.Project_Nodes.Table (Node).Field3;
1292 -------------------------
1293 -- Next_With_Clause_Of --
1294 -------------------------
1296 function Next_With_Clause_Of
1297 (Node : Project_Node_Id;
1298 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1304 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1305 return In_Tree.Project_Nodes.Table (Node).Field2;
1306 end Next_With_Clause_Of;
1312 function No (Node : Project_Node_Id) return Boolean is
1314 return Node = Empty_Node;
1317 ---------------------------------
1318 -- Non_Limited_Project_Node_Of --
1319 ---------------------------------
1321 function Non_Limited_Project_Node_Of
1322 (Node : Project_Node_Id;
1323 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1329 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1330 return In_Tree.Project_Nodes.Table (Node).Field3;
1331 end Non_Limited_Project_Node_Of;
1337 function Package_Id_Of
1338 (Node : Project_Node_Id;
1339 In_Tree : Project_Node_Tree_Ref) return Package_Node_Id
1345 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1346 return In_Tree.Project_Nodes.Table (Node).Pkg_Id;
1349 ---------------------
1350 -- Package_Node_Of --
1351 ---------------------
1353 function Package_Node_Of
1354 (Node : Project_Node_Id;
1355 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1361 (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1363 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1364 return In_Tree.Project_Nodes.Table (Node).Field2;
1365 end Package_Node_Of;
1371 function Path_Name_Of
1372 (Node : Project_Node_Id;
1373 In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
1379 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1381 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1382 return In_Tree.Project_Nodes.Table (Node).Path_Name;
1389 function Present (Node : Project_Node_Id) return Boolean is
1391 return Node /= Empty_Node;
1394 ----------------------------
1395 -- Project_Declaration_Of --
1396 ----------------------------
1398 function Project_Declaration_Of
1399 (Node : Project_Node_Id;
1400 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1406 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1407 return In_Tree.Project_Nodes.Table (Node).Field2;
1408 end Project_Declaration_Of;
1410 --------------------------
1411 -- Project_Qualifier_Of --
1412 --------------------------
1414 function Project_Qualifier_Of
1415 (Node : Project_Node_Id;
1416 In_Tree : Project_Node_Tree_Ref) return Project_Qualifier
1422 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1423 return In_Tree.Project_Nodes.Table (Node).Qualifier;
1424 end Project_Qualifier_Of;
1426 -----------------------
1427 -- Parent_Project_Of --
1428 -----------------------
1430 function Parent_Project_Of
1431 (Node : Project_Node_Id;
1432 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1438 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1439 return In_Tree.Project_Nodes.Table (Node).Field4;
1440 end Parent_Project_Of;
1442 -------------------------------------------
1443 -- Project_File_Includes_Unkept_Comments --
1444 -------------------------------------------
1446 function Project_File_Includes_Unkept_Comments
1447 (Node : Project_Node_Id;
1448 In_Tree : Project_Node_Tree_Ref) return Boolean
1450 Declaration : constant Project_Node_Id :=
1451 Project_Declaration_Of (Node, In_Tree);
1453 return In_Tree.Project_Nodes.Table (Declaration).Flag1;
1454 end Project_File_Includes_Unkept_Comments;
1456 ---------------------
1457 -- Project_Node_Of --
1458 ---------------------
1460 function Project_Node_Of
1461 (Node : Project_Node_Id;
1462 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1468 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
1470 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1472 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1473 return In_Tree.Project_Nodes.Table (Node).Field1;
1474 end Project_Node_Of;
1476 -----------------------------------
1477 -- Project_Of_Renamed_Package_Of --
1478 -----------------------------------
1480 function Project_Of_Renamed_Package_Of
1481 (Node : Project_Node_Id;
1482 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1488 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1489 return In_Tree.Project_Nodes.Table (Node).Field1;
1490 end Project_Of_Renamed_Package_Of;
1492 --------------------------
1493 -- Remove_Next_End_Node --
1494 --------------------------
1496 procedure Remove_Next_End_Node is
1498 Next_End_Nodes.Decrement_Last;
1499 end Remove_Next_End_Node;
1505 procedure Reset_State is
1507 End_Of_Line_Node := Empty_Node;
1508 Previous_Line_Node := Empty_Node;
1509 Previous_End_Node := Empty_Node;
1510 Unkept_Comments := False;
1511 Comments.Set_Last (0);
1514 ----------------------
1515 -- Restore_And_Free --
1516 ----------------------
1518 procedure Restore_And_Free (S : in out Comment_State) is
1519 procedure Unchecked_Free is new
1520 Ada.Unchecked_Deallocation (Comment_Array, Comments_Ptr);
1523 End_Of_Line_Node := S.End_Of_Line_Node;
1524 Previous_Line_Node := S.Previous_Line_Node;
1525 Previous_End_Node := S.Previous_End_Node;
1526 Next_End_Nodes.Set_Last (0);
1527 Unkept_Comments := S.Unkept_Comments;
1529 Comments.Set_Last (0);
1531 for J in S.Comments'Range loop
1532 Comments.Increment_Last;
1533 Comments.Table (Comments.Last) := S.Comments (J);
1536 Unchecked_Free (S.Comments);
1537 end Restore_And_Free;
1543 procedure Save (S : out Comment_State) is
1544 Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last);
1547 for J in 1 .. Comments.Last loop
1548 Cmts (J) := Comments.Table (J);
1552 (End_Of_Line_Node => End_Of_Line_Node,
1553 Previous_Line_Node => Previous_Line_Node,
1554 Previous_End_Node => Previous_End_Node,
1555 Unkept_Comments => Unkept_Comments,
1563 procedure Scan (In_Tree : Project_Node_Tree_Ref) is
1564 Empty_Line : Boolean := False;
1567 -- If there are comments, then they will not be kept. Set the flag and
1568 -- clear the comments.
1570 if Comments.Last > 0 then
1571 Unkept_Comments := True;
1572 Comments.Set_Last (0);
1575 -- Loop until a token other that End_Of_Line or Comment is found
1578 Prj.Err.Scanner.Scan;
1581 when Tok_End_Of_Line =>
1582 if Prev_Token = Tok_End_Of_Line then
1585 if Comments.Last > 0 then
1586 Comments.Table (Comments.Last).Is_Followed_By_Empty_Line
1592 -- If this is a line comment, add it to the comment table
1594 if Prev_Token = Tok_End_Of_Line
1595 or else Prev_Token = No_Token
1597 Comments.Increment_Last;
1598 Comments.Table (Comments.Last) :=
1599 (Value => Comment_Id,
1600 Follows_Empty_Line => Empty_Line,
1601 Is_Followed_By_Empty_Line => False);
1603 -- Otherwise, it is an end of line comment. If there is
1604 -- an end of line node specified, associate the comment with
1607 elsif Present (End_Of_Line_Node) then
1609 Zones : constant Project_Node_Id :=
1610 Comment_Zones_Of (End_Of_Line_Node, In_Tree);
1612 In_Tree.Project_Nodes.Table (Zones).Value := Comment_Id;
1615 -- Otherwise, this end of line node cannot be kept
1618 Unkept_Comments := True;
1619 Comments.Set_Last (0);
1622 Empty_Line := False;
1625 -- If there are comments, where the first comment is not
1626 -- following an empty line, put the initial uninterrupted
1627 -- comment zone with the node of the preceding line (either
1628 -- a Previous_Line or a Previous_End node), if any.
1630 if Comments.Last > 0 and then
1631 not Comments.Table (1).Follows_Empty_Line then
1632 if Present (Previous_Line_Node) then
1634 (To => Previous_Line_Node,
1636 In_Tree => In_Tree);
1638 elsif Present (Previous_End_Node) then
1640 (To => Previous_End_Node,
1642 In_Tree => In_Tree);
1646 -- If there are still comments and the token is "end", then
1647 -- put these comments with the Next_End node, if any;
1648 -- otherwise, these comments cannot be kept. Always clear
1651 if Comments.Last > 0 and then Token = Tok_End then
1652 if Next_End_Nodes.Last > 0 then
1654 (To => Next_End_Nodes.Table (Next_End_Nodes.Last),
1655 Where => Before_End,
1656 In_Tree => In_Tree);
1659 Unkept_Comments := True;
1662 Comments.Set_Last (0);
1665 -- Reset the End_Of_Line, Previous_Line and Previous_End nodes
1666 -- so that they are not used again.
1668 End_Of_Line_Node := Empty_Node;
1669 Previous_Line_Node := Empty_Node;
1670 Previous_End_Node := Empty_Node;
1679 ------------------------------------
1680 -- Set_Associative_Array_Index_Of --
1681 ------------------------------------
1683 procedure Set_Associative_Array_Index_Of
1684 (Node : Project_Node_Id;
1685 In_Tree : Project_Node_Tree_Ref;
1692 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1694 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1695 In_Tree.Project_Nodes.Table (Node).Value := To;
1696 end Set_Associative_Array_Index_Of;
1698 --------------------------------
1699 -- Set_Associative_Package_Of --
1700 --------------------------------
1702 procedure Set_Associative_Package_Of
1703 (Node : Project_Node_Id;
1704 In_Tree : Project_Node_Tree_Ref;
1705 To : Project_Node_Id)
1711 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
1712 In_Tree.Project_Nodes.Table (Node).Field3 := To;
1713 end Set_Associative_Package_Of;
1715 --------------------------------
1716 -- Set_Associative_Project_Of --
1717 --------------------------------
1719 procedure Set_Associative_Project_Of
1720 (Node : Project_Node_Id;
1721 In_Tree : Project_Node_Tree_Ref;
1722 To : Project_Node_Id)
1728 (In_Tree.Project_Nodes.Table (Node).Kind =
1729 N_Attribute_Declaration));
1730 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1731 end Set_Associative_Project_Of;
1733 --------------------------
1734 -- Set_Case_Insensitive --
1735 --------------------------
1737 procedure Set_Case_Insensitive
1738 (Node : Project_Node_Id;
1739 In_Tree : Project_Node_Tree_Ref;
1746 (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1748 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1749 In_Tree.Project_Nodes.Table (Node).Flag1 := To;
1750 end Set_Case_Insensitive;
1752 ------------------------------------
1753 -- Set_Case_Variable_Reference_Of --
1754 ------------------------------------
1756 procedure Set_Case_Variable_Reference_Of
1757 (Node : Project_Node_Id;
1758 In_Tree : Project_Node_Tree_Ref;
1759 To : Project_Node_Id)
1765 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1766 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1767 end Set_Case_Variable_Reference_Of;
1769 ---------------------------
1770 -- Set_Current_Item_Node --
1771 ---------------------------
1773 procedure Set_Current_Item_Node
1774 (Node : Project_Node_Id;
1775 In_Tree : Project_Node_Tree_Ref;
1776 To : Project_Node_Id)
1782 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1783 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1784 end Set_Current_Item_Node;
1786 ----------------------
1787 -- Set_Current_Term --
1788 ----------------------
1790 procedure Set_Current_Term
1791 (Node : Project_Node_Id;
1792 In_Tree : Project_Node_Tree_Ref;
1793 To : Project_Node_Id)
1799 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1800 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1801 end Set_Current_Term;
1803 ----------------------
1804 -- Set_Directory_Of --
1805 ----------------------
1807 procedure Set_Directory_Of
1808 (Node : Project_Node_Id;
1809 In_Tree : Project_Node_Tree_Ref;
1810 To : Path_Name_Type)
1816 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1817 In_Tree.Project_Nodes.Table (Node).Directory := To;
1818 end Set_Directory_Of;
1820 ---------------------
1821 -- Set_End_Of_Line --
1822 ---------------------
1824 procedure Set_End_Of_Line (To : Project_Node_Id) is
1826 End_Of_Line_Node := To;
1827 end Set_End_Of_Line;
1829 ----------------------------
1830 -- Set_Expression_Kind_Of --
1831 ----------------------------
1833 procedure Set_Expression_Kind_Of
1834 (Node : Project_Node_Id;
1835 In_Tree : Project_Node_Tree_Ref;
1841 and then -- should use Nkind_In here ??? why not???
1842 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
1844 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1846 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
1848 In_Tree.Project_Nodes.Table (Node).Kind =
1849 N_Typed_Variable_Declaration
1851 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
1853 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
1855 In_Tree.Project_Nodes.Table (Node).Kind = N_Term
1857 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1859 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference
1861 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value));
1862 In_Tree.Project_Nodes.Table (Node).Expr_Kind := To;
1863 end Set_Expression_Kind_Of;
1865 -----------------------
1866 -- Set_Expression_Of --
1867 -----------------------
1869 procedure Set_Expression_Of
1870 (Node : Project_Node_Id;
1871 In_Tree : Project_Node_Tree_Ref;
1872 To : Project_Node_Id)
1878 (In_Tree.Project_Nodes.Table (Node).Kind =
1879 N_Attribute_Declaration
1881 In_Tree.Project_Nodes.Table (Node).Kind =
1882 N_Typed_Variable_Declaration
1884 In_Tree.Project_Nodes.Table (Node).Kind =
1885 N_Variable_Declaration));
1886 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1887 end Set_Expression_Of;
1889 -------------------------------
1890 -- Set_External_Reference_Of --
1891 -------------------------------
1893 procedure Set_External_Reference_Of
1894 (Node : Project_Node_Id;
1895 In_Tree : Project_Node_Tree_Ref;
1896 To : Project_Node_Id)
1902 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
1903 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1904 end Set_External_Reference_Of;
1906 -----------------------------
1907 -- Set_External_Default_Of --
1908 -----------------------------
1910 procedure Set_External_Default_Of
1911 (Node : Project_Node_Id;
1912 In_Tree : Project_Node_Tree_Ref;
1913 To : Project_Node_Id)
1919 In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
1920 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1921 end Set_External_Default_Of;
1923 ----------------------------
1924 -- Set_First_Case_Item_Of --
1925 ----------------------------
1927 procedure Set_First_Case_Item_Of
1928 (Node : Project_Node_Id;
1929 In_Tree : Project_Node_Tree_Ref;
1930 To : Project_Node_Id)
1936 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1937 In_Tree.Project_Nodes.Table (Node).Field2 := To;
1938 end Set_First_Case_Item_Of;
1940 -------------------------
1941 -- Set_First_Choice_Of --
1942 -------------------------
1944 procedure Set_First_Choice_Of
1945 (Node : Project_Node_Id;
1946 In_Tree : Project_Node_Tree_Ref;
1947 To : Project_Node_Id)
1953 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1954 In_Tree.Project_Nodes.Table (Node).Field1 := To;
1955 end Set_First_Choice_Of;
1957 -----------------------------
1958 -- Set_First_Comment_After --
1959 -----------------------------
1961 procedure Set_First_Comment_After
1962 (Node : Project_Node_Id;
1963 In_Tree : Project_Node_Tree_Ref;
1964 To : Project_Node_Id)
1966 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1968 In_Tree.Project_Nodes.Table (Zone).Field2 := To;
1969 end Set_First_Comment_After;
1971 ---------------------------------
1972 -- Set_First_Comment_After_End --
1973 ---------------------------------
1975 procedure Set_First_Comment_After_End
1976 (Node : Project_Node_Id;
1977 In_Tree : Project_Node_Tree_Ref;
1978 To : Project_Node_Id)
1980 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1982 In_Tree.Project_Nodes.Table (Zone).Comments := To;
1983 end Set_First_Comment_After_End;
1985 ------------------------------
1986 -- Set_First_Comment_Before --
1987 ------------------------------
1989 procedure Set_First_Comment_Before
1990 (Node : Project_Node_Id;
1991 In_Tree : Project_Node_Tree_Ref;
1992 To : Project_Node_Id)
1995 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1997 In_Tree.Project_Nodes.Table (Zone).Field1 := To;
1998 end Set_First_Comment_Before;
2000 ----------------------------------
2001 -- Set_First_Comment_Before_End --
2002 ----------------------------------
2004 procedure Set_First_Comment_Before_End
2005 (Node : Project_Node_Id;
2006 In_Tree : Project_Node_Tree_Ref;
2007 To : Project_Node_Id)
2009 Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2011 In_Tree.Project_Nodes.Table (Zone).Field2 := To;
2012 end Set_First_Comment_Before_End;
2014 ------------------------
2015 -- Set_Next_Case_Item --
2016 ------------------------
2018 procedure Set_Next_Case_Item
2019 (Node : Project_Node_Id;
2020 In_Tree : Project_Node_Tree_Ref;
2021 To : Project_Node_Id)
2027 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
2028 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2029 end Set_Next_Case_Item;
2031 ----------------------
2032 -- Set_Next_Comment --
2033 ----------------------
2035 procedure Set_Next_Comment
2036 (Node : Project_Node_Id;
2037 In_Tree : Project_Node_Tree_Ref;
2038 To : Project_Node_Id)
2044 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
2045 In_Tree.Project_Nodes.Table (Node).Comments := To;
2046 end Set_Next_Comment;
2048 -----------------------------------
2049 -- Set_First_Declarative_Item_Of --
2050 -----------------------------------
2052 procedure Set_First_Declarative_Item_Of
2053 (Node : Project_Node_Id;
2054 In_Tree : Project_Node_Tree_Ref;
2055 To : Project_Node_Id)
2061 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
2063 In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
2065 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2067 if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
2068 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2070 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2072 end Set_First_Declarative_Item_Of;
2074 ----------------------------------
2075 -- Set_First_Expression_In_List --
2076 ----------------------------------
2078 procedure Set_First_Expression_In_List
2079 (Node : Project_Node_Id;
2080 In_Tree : Project_Node_Tree_Ref;
2081 To : Project_Node_Id)
2087 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
2088 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2089 end Set_First_Expression_In_List;
2091 ------------------------------
2092 -- Set_First_Literal_String --
2093 ------------------------------
2095 procedure Set_First_Literal_String
2096 (Node : Project_Node_Id;
2097 In_Tree : Project_Node_Tree_Ref;
2098 To : Project_Node_Id)
2104 In_Tree.Project_Nodes.Table (Node).Kind =
2105 N_String_Type_Declaration);
2106 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2107 end Set_First_Literal_String;
2109 --------------------------
2110 -- Set_First_Package_Of --
2111 --------------------------
2113 procedure Set_First_Package_Of
2114 (Node : Project_Node_Id;
2115 In_Tree : Project_Node_Tree_Ref;
2116 To : Package_Declaration_Id)
2122 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2123 In_Tree.Project_Nodes.Table (Node).Packages := To;
2124 end Set_First_Package_Of;
2126 ------------------------------
2127 -- Set_First_String_Type_Of --
2128 ------------------------------
2130 procedure Set_First_String_Type_Of
2131 (Node : Project_Node_Id;
2132 In_Tree : Project_Node_Tree_Ref;
2133 To : Project_Node_Id)
2139 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2140 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2141 end Set_First_String_Type_Of;
2143 --------------------
2144 -- Set_First_Term --
2145 --------------------
2147 procedure Set_First_Term
2148 (Node : Project_Node_Id;
2149 In_Tree : Project_Node_Tree_Ref;
2150 To : Project_Node_Id)
2156 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2157 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2160 ---------------------------
2161 -- Set_First_Variable_Of --
2162 ---------------------------
2164 procedure Set_First_Variable_Of
2165 (Node : Project_Node_Id;
2166 In_Tree : Project_Node_Tree_Ref;
2167 To : Variable_Node_Id)
2173 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2175 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2176 In_Tree.Project_Nodes.Table (Node).Variables := To;
2177 end Set_First_Variable_Of;
2179 ------------------------------
2180 -- Set_First_With_Clause_Of --
2181 ------------------------------
2183 procedure Set_First_With_Clause_Of
2184 (Node : Project_Node_Id;
2185 In_Tree : Project_Node_Tree_Ref;
2186 To : Project_Node_Id)
2192 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2193 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2194 end Set_First_With_Clause_Of;
2196 --------------------------
2197 -- Set_Is_Extending_All --
2198 --------------------------
2200 procedure Set_Is_Extending_All
2201 (Node : Project_Node_Id;
2202 In_Tree : Project_Node_Tree_Ref)
2208 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2210 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2211 In_Tree.Project_Nodes.Table (Node).Flag2 := True;
2212 end Set_Is_Extending_All;
2214 -----------------------------
2215 -- Set_Is_Not_Last_In_List --
2216 -----------------------------
2218 procedure Set_Is_Not_Last_In_List
2219 (Node : Project_Node_Id;
2220 In_Tree : Project_Node_Tree_Ref)
2226 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2227 In_Tree.Project_Nodes.Table (Node).Flag1 := True;
2228 end Set_Is_Not_Last_In_List;
2234 procedure Set_Kind_Of
2235 (Node : Project_Node_Id;
2236 In_Tree : Project_Node_Tree_Ref;
2237 To : Project_Node_Kind)
2240 pragma Assert (Present (Node));
2241 In_Tree.Project_Nodes.Table (Node).Kind := To;
2244 ---------------------
2245 -- Set_Location_Of --
2246 ---------------------
2248 procedure Set_Location_Of
2249 (Node : Project_Node_Id;
2250 In_Tree : Project_Node_Tree_Ref;
2254 pragma Assert (Present (Node));
2255 In_Tree.Project_Nodes.Table (Node).Location := To;
2256 end Set_Location_Of;
2258 -----------------------------
2259 -- Set_Extended_Project_Of --
2260 -----------------------------
2262 procedure Set_Extended_Project_Of
2263 (Node : Project_Node_Id;
2264 In_Tree : Project_Node_Tree_Ref;
2265 To : Project_Node_Id)
2271 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2272 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2273 end Set_Extended_Project_Of;
2275 ----------------------------------
2276 -- Set_Extended_Project_Path_Of --
2277 ----------------------------------
2279 procedure Set_Extended_Project_Path_Of
2280 (Node : Project_Node_Id;
2281 In_Tree : Project_Node_Tree_Ref;
2282 To : Path_Name_Type)
2288 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2289 In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To);
2290 end Set_Extended_Project_Path_Of;
2292 ------------------------------
2293 -- Set_Extending_Project_Of --
2294 ------------------------------
2296 procedure Set_Extending_Project_Of
2297 (Node : Project_Node_Id;
2298 In_Tree : Project_Node_Tree_Ref;
2299 To : Project_Node_Id)
2305 In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2306 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2307 end Set_Extending_Project_Of;
2313 procedure Set_Name_Of
2314 (Node : Project_Node_Id;
2315 In_Tree : Project_Node_Tree_Ref;
2319 pragma Assert (Present (Node));
2320 In_Tree.Project_Nodes.Table (Node).Name := To;
2323 -------------------------------
2324 -- Set_Next_Declarative_Item --
2325 -------------------------------
2327 procedure Set_Next_Declarative_Item
2328 (Node : Project_Node_Id;
2329 In_Tree : Project_Node_Tree_Ref;
2330 To : Project_Node_Id)
2336 In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
2337 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2338 end Set_Next_Declarative_Item;
2340 -----------------------
2341 -- Set_Next_End_Node --
2342 -----------------------
2344 procedure Set_Next_End_Node (To : Project_Node_Id) is
2346 Next_End_Nodes.Increment_Last;
2347 Next_End_Nodes.Table (Next_End_Nodes.Last) := To;
2348 end Set_Next_End_Node;
2350 ---------------------------------
2351 -- Set_Next_Expression_In_List --
2352 ---------------------------------
2354 procedure Set_Next_Expression_In_List
2355 (Node : Project_Node_Id;
2356 In_Tree : Project_Node_Tree_Ref;
2357 To : Project_Node_Id)
2363 In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2364 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2365 end Set_Next_Expression_In_List;
2367 -----------------------------
2368 -- Set_Next_Literal_String --
2369 -----------------------------
2371 procedure Set_Next_Literal_String
2372 (Node : Project_Node_Id;
2373 In_Tree : Project_Node_Tree_Ref;
2374 To : Project_Node_Id)
2380 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
2381 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2382 end Set_Next_Literal_String;
2384 ---------------------------------
2385 -- Set_Next_Package_In_Project --
2386 ---------------------------------
2388 procedure Set_Next_Package_In_Project
2389 (Node : Project_Node_Id;
2390 In_Tree : Project_Node_Tree_Ref;
2391 To : Project_Node_Id)
2397 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2398 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2399 end Set_Next_Package_In_Project;
2401 --------------------------
2402 -- Set_Next_String_Type --
2403 --------------------------
2405 procedure Set_Next_String_Type
2406 (Node : Project_Node_Id;
2407 In_Tree : Project_Node_Tree_Ref;
2408 To : Project_Node_Id)
2414 In_Tree.Project_Nodes.Table (Node).Kind =
2415 N_String_Type_Declaration);
2416 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2417 end Set_Next_String_Type;
2423 procedure Set_Next_Term
2424 (Node : Project_Node_Id;
2425 In_Tree : Project_Node_Tree_Ref;
2426 To : Project_Node_Id)
2432 In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
2433 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2436 -----------------------
2437 -- Set_Next_Variable --
2438 -----------------------
2440 procedure Set_Next_Variable
2441 (Node : Project_Node_Id;
2442 In_Tree : Project_Node_Tree_Ref;
2443 To : Project_Node_Id)
2449 (In_Tree.Project_Nodes.Table (Node).Kind =
2450 N_Typed_Variable_Declaration
2452 In_Tree.Project_Nodes.Table (Node).Kind =
2453 N_Variable_Declaration));
2454 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2455 end Set_Next_Variable;
2457 -----------------------------
2458 -- Set_Next_With_Clause_Of --
2459 -----------------------------
2461 procedure Set_Next_With_Clause_Of
2462 (Node : Project_Node_Id;
2463 In_Tree : Project_Node_Tree_Ref;
2464 To : Project_Node_Id)
2470 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2471 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2472 end Set_Next_With_Clause_Of;
2474 -----------------------
2475 -- Set_Package_Id_Of --
2476 -----------------------
2478 procedure Set_Package_Id_Of
2479 (Node : Project_Node_Id;
2480 In_Tree : Project_Node_Tree_Ref;
2481 To : Package_Node_Id)
2487 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2488 In_Tree.Project_Nodes.Table (Node).Pkg_Id := To;
2489 end Set_Package_Id_Of;
2491 -------------------------
2492 -- Set_Package_Node_Of --
2493 -------------------------
2495 procedure Set_Package_Node_Of
2496 (Node : Project_Node_Id;
2497 In_Tree : Project_Node_Tree_Ref;
2498 To : Project_Node_Id)
2504 (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2506 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2507 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2508 end Set_Package_Node_Of;
2510 ----------------------
2511 -- Set_Path_Name_Of --
2512 ----------------------
2514 procedure Set_Path_Name_Of
2515 (Node : Project_Node_Id;
2516 In_Tree : Project_Node_Tree_Ref;
2517 To : Path_Name_Type)
2523 (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2525 In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2526 In_Tree.Project_Nodes.Table (Node).Path_Name := To;
2527 end Set_Path_Name_Of;
2529 ---------------------------
2530 -- Set_Previous_End_Node --
2531 ---------------------------
2532 procedure Set_Previous_End_Node (To : Project_Node_Id) is
2534 Previous_End_Node := To;
2535 end Set_Previous_End_Node;
2537 ----------------------------
2538 -- Set_Previous_Line_Node --
2539 ----------------------------
2541 procedure Set_Previous_Line_Node (To : Project_Node_Id) is
2543 Previous_Line_Node := To;
2544 end Set_Previous_Line_Node;
2546 --------------------------------
2547 -- Set_Project_Declaration_Of --
2548 --------------------------------
2550 procedure Set_Project_Declaration_Of
2551 (Node : Project_Node_Id;
2552 In_Tree : Project_Node_Tree_Ref;
2553 To : Project_Node_Id)
2559 In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2560 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2561 end Set_Project_Declaration_Of;
2563 ------------------------------
2564 -- Set_Project_Qualifier_Of --
2565 ------------------------------
2567 procedure Set_Project_Qualifier_Of
2568 (Node : Project_Node_Id;
2569 In_Tree : Project_Node_Tree_Ref;
2570 To : Project_Qualifier)
2575 and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2576 In_Tree.Project_Nodes.Table (Node).Qualifier := To;
2577 end Set_Project_Qualifier_Of;
2579 ---------------------------
2580 -- Set_Parent_Project_Of --
2581 ---------------------------
2583 procedure Set_Parent_Project_Of
2584 (Node : Project_Node_Id;
2585 In_Tree : Project_Node_Tree_Ref;
2586 To : Project_Node_Id)
2591 and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2592 In_Tree.Project_Nodes.Table (Node).Field4 := To;
2593 end Set_Parent_Project_Of;
2595 -----------------------------------------------
2596 -- Set_Project_File_Includes_Unkept_Comments --
2597 -----------------------------------------------
2599 procedure Set_Project_File_Includes_Unkept_Comments
2600 (Node : Project_Node_Id;
2601 In_Tree : Project_Node_Tree_Ref;
2604 Declaration : constant Project_Node_Id :=
2605 Project_Declaration_Of (Node, In_Tree);
2607 In_Tree.Project_Nodes.Table (Declaration).Flag1 := To;
2608 end Set_Project_File_Includes_Unkept_Comments;
2610 -------------------------
2611 -- Set_Project_Node_Of --
2612 -------------------------
2614 procedure Set_Project_Node_Of
2615 (Node : Project_Node_Id;
2616 In_Tree : Project_Node_Tree_Ref;
2617 To : Project_Node_Id;
2618 Limited_With : Boolean := False)
2624 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2626 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2628 In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2629 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2631 if In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2632 and then not Limited_With
2634 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2636 end Set_Project_Node_Of;
2638 ---------------------------------------
2639 -- Set_Project_Of_Renamed_Package_Of --
2640 ---------------------------------------
2642 procedure Set_Project_Of_Renamed_Package_Of
2643 (Node : Project_Node_Id;
2644 In_Tree : Project_Node_Tree_Ref;
2645 To : Project_Node_Id)
2651 In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2652 In_Tree.Project_Nodes.Table (Node).Field1 := To;
2653 end Set_Project_Of_Renamed_Package_Of;
2655 -------------------------
2656 -- Set_Source_Index_Of --
2657 -------------------------
2659 procedure Set_Source_Index_Of
2660 (Node : Project_Node_Id;
2661 In_Tree : Project_Node_Tree_Ref;
2668 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2670 In_Tree.Project_Nodes.Table (Node).Kind =
2671 N_Attribute_Declaration));
2672 In_Tree.Project_Nodes.Table (Node).Src_Index := To;
2673 end Set_Source_Index_Of;
2675 ------------------------
2676 -- Set_String_Type_Of --
2677 ------------------------
2679 procedure Set_String_Type_Of
2680 (Node : Project_Node_Id;
2681 In_Tree : Project_Node_Tree_Ref;
2682 To : Project_Node_Id)
2688 (In_Tree.Project_Nodes.Table (Node).Kind =
2689 N_Variable_Reference
2691 In_Tree.Project_Nodes.Table (Node).Kind =
2692 N_Typed_Variable_Declaration)
2694 In_Tree.Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
2696 if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2697 In_Tree.Project_Nodes.Table (Node).Field3 := To;
2699 In_Tree.Project_Nodes.Table (Node).Field2 := To;
2701 end Set_String_Type_Of;
2703 -------------------------
2704 -- Set_String_Value_Of --
2705 -------------------------
2707 procedure Set_String_Value_Of
2708 (Node : Project_Node_Id;
2709 In_Tree : Project_Node_Tree_Ref;
2716 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2718 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2720 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2721 In_Tree.Project_Nodes.Table (Node).Value := To;
2722 end Set_String_Value_Of;
2724 ---------------------
2725 -- Source_Index_Of --
2726 ---------------------
2728 function Source_Index_Of
2729 (Node : Project_Node_Id;
2730 In_Tree : Project_Node_Tree_Ref) return Int
2736 (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2738 In_Tree.Project_Nodes.Table (Node).Kind =
2739 N_Attribute_Declaration));
2740 return In_Tree.Project_Nodes.Table (Node).Src_Index;
2741 end Source_Index_Of;
2743 --------------------
2744 -- String_Type_Of --
2745 --------------------
2747 function String_Type_Of
2748 (Node : Project_Node_Id;
2749 In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
2755 (In_Tree.Project_Nodes.Table (Node).Kind =
2756 N_Variable_Reference
2758 In_Tree.Project_Nodes.Table (Node).Kind =
2759 N_Typed_Variable_Declaration));
2761 if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2762 return In_Tree.Project_Nodes.Table (Node).Field3;
2764 return In_Tree.Project_Nodes.Table (Node).Field2;
2768 ---------------------
2769 -- String_Value_Of --
2770 ---------------------
2772 function String_Value_Of
2773 (Node : Project_Node_Id;
2774 In_Tree : Project_Node_Tree_Ref) return Name_Id
2780 (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2782 In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2784 In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2785 return In_Tree.Project_Nodes.Table (Node).Value;
2786 end String_Value_Of;
2788 --------------------
2789 -- Value_Is_Valid --
2790 --------------------
2792 function Value_Is_Valid
2793 (For_Typed_Variable : Project_Node_Id;
2794 In_Tree : Project_Node_Tree_Ref;
2795 Value : Name_Id) return Boolean
2799 (Present (For_Typed_Variable)
2801 (In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind =
2802 N_Typed_Variable_Declaration));
2805 Current_String : Project_Node_Id :=
2806 First_Literal_String
2807 (String_Type_Of (For_Typed_Variable, In_Tree),
2811 while Present (Current_String)
2813 String_Value_Of (Current_String, In_Tree) /= Value
2816 Next_Literal_String (Current_String, In_Tree);
2819 return Present (Current_String);
2824 -------------------------------
2825 -- There_Are_Unkept_Comments --
2826 -------------------------------
2828 function There_Are_Unkept_Comments return Boolean is
2830 return Unkept_Comments;
2831 end There_Are_Unkept_Comments;
2833 --------------------
2834 -- Create_Project --
2835 --------------------
2837 function Create_Project
2838 (In_Tree : Project_Node_Tree_Ref;
2840 Full_Path : Path_Name_Type;
2841 Is_Config_File : Boolean := False) return Project_Node_Id
2843 Project : Project_Node_Id;
2844 Qualifier : Project_Qualifier := Unspecified;
2846 Project := Default_Project_Node (In_Tree, N_Project);
2847 Set_Name_Of (Project, In_Tree, Name);
2850 Path_Name_Type (Get_Directory (File_Name_Type (Full_Path))));
2851 Set_Path_Name_Of (Project, In_Tree, Full_Path);
2853 Set_Project_Declaration_Of
2855 Default_Project_Node (In_Tree, N_Project_Declaration));
2857 if Is_Config_File then
2858 Qualifier := Configuration;
2861 if not Is_Config_File then
2862 Prj.Tree.Tree_Private_Part.Projects_Htable.Set
2863 (In_Tree.Projects_HT,
2865 Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
2867 Display_Name => Name,
2868 Canonical_Path => No_Path,
2871 Proj_Qualifier => Qualifier));
2881 procedure Add_At_End
2882 (Tree : Project_Node_Tree_Ref;
2883 Parent : Project_Node_Id;
2884 Expr : Project_Node_Id;
2885 Add_Before_First_Pkg : Boolean := False;
2886 Add_Before_First_Case : Boolean := False)
2888 Real_Parent : Project_Node_Id;
2889 New_Decl, Decl, Next : Project_Node_Id;
2890 Last, L : Project_Node_Id;
2893 if Kind_Of (Expr, Tree) /= N_Declarative_Item then
2894 New_Decl := Default_Project_Node (Tree, N_Declarative_Item);
2895 Set_Current_Item_Node (New_Decl, Tree, Expr);
2900 if Kind_Of (Parent, Tree) = N_Project then
2901 Real_Parent := Project_Declaration_Of (Parent, Tree);
2903 Real_Parent := Parent;
2906 Decl := First_Declarative_Item_Of (Real_Parent, Tree);
2908 if Decl = Empty_Node then
2909 Set_First_Declarative_Item_Of (Real_Parent, Tree, New_Decl);
2912 Next := Next_Declarative_Item (Decl, Tree);
2913 exit when Next = Empty_Node
2915 (Add_Before_First_Pkg
2916 and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
2917 N_Package_Declaration)
2919 (Add_Before_First_Case
2920 and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
2921 N_Case_Construction);
2925 -- In case Expr is in fact a range of declarative items
2929 L := Next_Declarative_Item (Last, Tree);
2930 exit when L = Empty_Node;
2934 -- In case Expr is in fact a range of declarative items
2938 L := Next_Declarative_Item (Last, Tree);
2939 exit when L = Empty_Node;
2943 Set_Next_Declarative_Item (Last, Tree, Next);
2944 Set_Next_Declarative_Item (Decl, Tree, New_Decl);
2948 ---------------------------
2949 -- Create_Literal_String --
2950 ---------------------------
2952 function Create_Literal_String
2953 (Str : Namet.Name_Id;
2954 Tree : Project_Node_Tree_Ref) return Project_Node_Id
2956 Node : Project_Node_Id;
2958 Node := Default_Project_Node (Tree, N_Literal_String, Prj.Single);
2959 Set_Next_Literal_String (Node, Tree, Empty_Node);
2960 Set_String_Value_Of (Node, Tree, Str);
2962 end Create_Literal_String;
2964 ---------------------------
2965 -- Enclose_In_Expression --
2966 ---------------------------
2968 function Enclose_In_Expression
2969 (Node : Project_Node_Id;
2970 Tree : Project_Node_Tree_Ref) return Project_Node_Id
2972 Expr : Project_Node_Id;
2974 if Kind_Of (Node, Tree) /= N_Expression then
2975 Expr := Default_Project_Node (Tree, N_Expression, Single);
2977 (Expr, Tree, Default_Project_Node (Tree, N_Term, Single));
2978 Set_Current_Term (First_Term (Expr, Tree), Tree, Node);
2983 end Enclose_In_Expression;
2985 --------------------
2986 -- Create_Package --
2987 --------------------
2989 function Create_Package
2990 (Tree : Project_Node_Tree_Ref;
2991 Project : Project_Node_Id;
2992 Pkg : String) return Project_Node_Id
2994 Pack : Project_Node_Id;
2998 Name_Len := Pkg'Length;
2999 Name_Buffer (1 .. Name_Len) := Pkg;
3002 -- Check if the package already exists
3004 Pack := First_Package_Of (Project, Tree);
3005 while Pack /= Empty_Node loop
3006 if Prj.Tree.Name_Of (Pack, Tree) = N then
3010 Pack := Next_Package_In_Project (Pack, Tree);
3013 -- Create the package and add it to the declarative item
3015 Pack := Default_Project_Node (Tree, N_Package_Declaration);
3016 Set_Name_Of (Pack, Tree, N);
3018 -- Find the correct package id to use
3020 Set_Package_Id_Of (Pack, Tree, Package_Node_Id_Of (N));
3022 -- Add it to the list of packages
3024 Set_Next_Package_In_Project
3025 (Pack, Tree, First_Package_Of (Project, Tree));
3026 Set_First_Package_Of (Project, Tree, Pack);
3028 Add_At_End (Tree, Project_Declaration_Of (Project, Tree), Pack);
3033 ----------------------
3034 -- Create_Attribute --
3035 ----------------------
3037 function Create_Attribute
3038 (Tree : Project_Node_Tree_Ref;
3039 Prj_Or_Pkg : Project_Node_Id;
3041 Index_Name : Name_Id := No_Name;
3042 Kind : Variable_Kind := List;
3043 At_Index : Integer := 0;
3044 Value : Project_Node_Id := Empty_Node) return Project_Node_Id
3046 Node : constant Project_Node_Id :=
3047 Default_Project_Node (Tree, N_Attribute_Declaration, Kind);
3049 Case_Insensitive : Boolean;
3051 Pkg : Package_Node_Id;
3052 Start_At : Attribute_Node_Id;
3053 Expr : Project_Node_Id;
3056 Set_Name_Of (Node, Tree, Name);
3058 if Index_Name /= No_Name then
3059 Set_Associative_Array_Index_Of (Node, Tree, Index_Name);
3062 if Prj_Or_Pkg /= Empty_Node then
3063 Add_At_End (Tree, Prj_Or_Pkg, Node);
3066 -- Find out the case sensitivity of the attribute
3068 if Prj_Or_Pkg /= Empty_Node
3069 and then Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration
3071 Pkg := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree));
3072 Start_At := First_Attribute_Of (Pkg);
3074 Start_At := Attribute_First;
3077 Start_At := Attribute_Node_Id_Of (Name, Start_At);
3079 Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array;
3080 Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive;
3082 if At_Index /= 0 then
3083 if Attribute_Kind_Of (Start_At) =
3084 Optional_Index_Associative_Array
3085 or else Attribute_Kind_Of (Start_At) =
3086 Optional_Index_Case_Insensitive_Associative_Array
3088 -- Results in: for Name ("index" at index) use "value";
3089 -- This is currently only used for executables.
3091 Set_Source_Index_Of (Node, Tree, To => Int (At_Index));
3094 -- Results in: for Name ("index") use "value" at index;
3096 -- ??? This limitation makes no sense, we should be able to
3097 -- set the source index on an expression.
3099 pragma Assert (Kind_Of (Value, Tree) = N_Literal_String);
3100 Set_Source_Index_Of (Value, Tree, To => Int (At_Index));
3104 if Value /= Empty_Node then
3105 Expr := Enclose_In_Expression (Value, Tree);
3106 Set_Expression_Of (Node, Tree, Expr);
3110 end Create_Attribute;