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;