1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2014, 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
,
122 Display_Name
=> No_Name
,
124 Path_Name
=> No_Path
,
126 Default
=> Empty_Value
,
127 Field1
=> Empty_Node
,
128 Field2
=> Empty_Node
,
129 Field3
=> Empty_Node
,
130 Field4
=> Empty_Node
,
133 Comments
=> Empty_Node
);
135 Zone
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
136 In_Tree
.Project_Nodes
.Table
(To
).Comments
:= Zone
;
139 if Where
= End_Of_Line
then
140 In_Tree
.Project_Nodes
.Table
(Zone
).Value
:= Comments
.Table
(1).Value
;
143 -- Get each comments in the Comments table and link them to node To
145 for J
in 1 .. Comments
.Last
loop
147 -- Create new N_Comment node
149 if (Where
= After
or else Where
= After_End
)
150 and then Token
/= Tok_EOF
151 and then Comments
.Table
(J
).Follows_Empty_Line
153 Comments
.Table
(1 .. Comments
.Last
- J
+ 1) :=
154 Comments
.Table
(J
.. Comments
.Last
);
155 Comments
.Set_Last
(Comments
.Last
- J
+ 1);
159 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
160 In_Tree
.Project_Nodes
.Table
161 (Project_Node_Table
.Last
(In_Tree
.Project_Nodes
)) :=
163 Qualifier
=> Unspecified
,
164 Expr_Kind
=> Undefined
,
165 Flag1
=> Comments
.Table
(J
).Follows_Empty_Line
,
167 Comments
.Table
(J
).Is_Followed_By_Empty_Line
,
168 Location
=> No_Location
,
169 Directory
=> No_Path
,
170 Variables
=> Empty_Node
,
171 Packages
=> Empty_Node
,
172 Pkg_Id
=> Empty_Package
,
174 Display_Name
=> No_Name
,
176 Path_Name
=> No_Path
,
177 Value
=> Comments
.Table
(J
).Value
,
178 Default
=> Empty_Value
,
179 Field1
=> Empty_Node
,
180 Field2
=> Empty_Node
,
181 Field3
=> Empty_Node
,
182 Field4
=> Empty_Node
,
183 Comments
=> Empty_Node
);
185 -- If this is the first comment, put it in the right field of
188 if No
(Previous
) then
191 In_Tree
.Project_Nodes
.Table
(Zone
).Field1
:=
192 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
195 In_Tree
.Project_Nodes
.Table
(Zone
).Field2
:=
196 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
199 In_Tree
.Project_Nodes
.Table
(Zone
).Field3
:=
200 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
203 In_Tree
.Project_Nodes
.Table
(Zone
).Comments
:=
204 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
211 -- When it is not the first, link it to the previous one
213 In_Tree
.Project_Nodes
.Table
(Previous
).Comments
:=
214 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
217 -- This node becomes the previous one for the next comment, if
220 Previous
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
224 -- Empty the Comments table, so that there is no risk to link the same
225 -- comments to another node.
227 Comments
.Set_Last
(0);
230 --------------------------------
231 -- Associative_Array_Index_Of --
232 --------------------------------
234 function Associative_Array_Index_Of
235 (Node
: Project_Node_Id
;
236 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
242 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
244 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
245 return In_Tree
.Project_Nodes
.Table
(Node
).Value
;
246 end Associative_Array_Index_Of
;
248 ----------------------------
249 -- Associative_Package_Of --
250 ----------------------------
252 function Associative_Package_Of
253 (Node
: Project_Node_Id
;
254 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
260 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
));
261 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
262 end Associative_Package_Of
;
264 ----------------------------
265 -- Associative_Project_Of --
266 ----------------------------
268 function Associative_Project_Of
269 (Node
: Project_Node_Id
;
270 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
276 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
));
277 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
278 end Associative_Project_Of
;
280 ----------------------
281 -- Case_Insensitive --
282 ----------------------
284 function Case_Insensitive
285 (Node
: Project_Node_Id
;
286 In_Tree
: Project_Node_Tree_Ref
) return Boolean
292 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
294 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
295 return In_Tree
.Project_Nodes
.Table
(Node
).Flag1
;
296 end Case_Insensitive
;
298 --------------------------------
299 -- Case_Variable_Reference_Of --
300 --------------------------------
302 function Case_Variable_Reference_Of
303 (Node
: Project_Node_Id
;
304 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
310 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
311 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
312 end Case_Variable_Reference_Of
;
314 ----------------------
315 -- Comment_Zones_Of --
316 ----------------------
318 function Comment_Zones_Of
319 (Node
: Project_Node_Id
;
320 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
322 Zone
: Project_Node_Id
;
325 pragma Assert
(Present
(Node
));
326 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
328 -- If there is not already an N_Comment_Zones associated, create a new
329 -- one and associate it with node Node.
332 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
333 Zone
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
334 In_Tree
.Project_Nodes
.Table
(Zone
) :=
335 (Kind
=> N_Comment_Zones
,
336 Qualifier
=> Unspecified
,
337 Location
=> No_Location
,
338 Directory
=> No_Path
,
339 Expr_Kind
=> Undefined
,
340 Variables
=> Empty_Node
,
341 Packages
=> Empty_Node
,
342 Pkg_Id
=> Empty_Package
,
344 Display_Name
=> No_Name
,
346 Path_Name
=> No_Path
,
348 Default
=> Empty_Value
,
349 Field1
=> Empty_Node
,
350 Field2
=> Empty_Node
,
351 Field3
=> Empty_Node
,
352 Field4
=> Empty_Node
,
355 Comments
=> Empty_Node
);
356 In_Tree
.Project_Nodes
.Table
(Node
).Comments
:= Zone
;
360 end Comment_Zones_Of
;
362 -----------------------
363 -- Current_Item_Node --
364 -----------------------
366 function Current_Item_Node
367 (Node
: Project_Node_Id
;
368 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
374 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
375 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
376 end Current_Item_Node
;
382 function Current_Term
383 (Node
: Project_Node_Id
;
384 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
390 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
);
391 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
399 (Node
: Project_Node_Id
;
400 In_Tree
: Project_Node_Tree_Ref
) return Attribute_Default_Value
406 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
);
407 return In_Tree
.Project_Nodes
.Table
(Node
).Default
;
410 --------------------------
411 -- Default_Project_Node --
412 --------------------------
414 function Default_Project_Node
415 (In_Tree
: Project_Node_Tree_Ref
;
416 Of_Kind
: Project_Node_Kind
;
417 And_Expr_Kind
: Variable_Kind
:= Undefined
) return Project_Node_Id
419 Result
: Project_Node_Id
;
420 Zone
: Project_Node_Id
;
421 Previous
: Project_Node_Id
;
424 -- Create new node with specified kind and expression kind
426 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
427 In_Tree
.Project_Nodes
.Table
428 (Project_Node_Table
.Last
(In_Tree
.Project_Nodes
)) :=
430 Qualifier
=> Unspecified
,
431 Location
=> No_Location
,
432 Directory
=> No_Path
,
433 Expr_Kind
=> And_Expr_Kind
,
434 Variables
=> Empty_Node
,
435 Packages
=> Empty_Node
,
436 Pkg_Id
=> Empty_Package
,
438 Display_Name
=> No_Name
,
440 Path_Name
=> No_Path
,
442 Default
=> Empty_Value
,
443 Field1
=> Empty_Node
,
444 Field2
=> Empty_Node
,
445 Field3
=> Empty_Node
,
446 Field4
=> Empty_Node
,
449 Comments
=> Empty_Node
);
451 -- Save the new node for the returned value
453 Result
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
455 if Comments
.Last
> 0 then
457 -- If this is not a node with comments, then set the flag
459 if not Node_With_Comments
(Of_Kind
) then
460 Unkept_Comments
:= True;
462 elsif Of_Kind
/= N_Comment
and then Of_Kind
/= N_Comment_Zones
then
464 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
465 In_Tree
.Project_Nodes
.Table
466 (Project_Node_Table
.Last
(In_Tree
.Project_Nodes
)) :=
467 (Kind
=> N_Comment_Zones
,
468 Qualifier
=> Unspecified
,
469 Expr_Kind
=> Undefined
,
470 Location
=> No_Location
,
471 Directory
=> No_Path
,
472 Variables
=> Empty_Node
,
473 Packages
=> Empty_Node
,
474 Pkg_Id
=> Empty_Package
,
476 Display_Name
=> No_Name
,
478 Path_Name
=> No_Path
,
480 Default
=> Empty_Value
,
481 Field1
=> Empty_Node
,
482 Field2
=> Empty_Node
,
483 Field3
=> Empty_Node
,
484 Field4
=> Empty_Node
,
487 Comments
=> Empty_Node
);
489 Zone
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
490 In_Tree
.Project_Nodes
.Table
(Result
).Comments
:= Zone
;
491 Previous
:= Empty_Node
;
493 for J
in 1 .. Comments
.Last
loop
495 -- Create a new N_Comment node
497 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
498 In_Tree
.Project_Nodes
.Table
499 (Project_Node_Table
.Last
(In_Tree
.Project_Nodes
)) :=
501 Qualifier
=> Unspecified
,
502 Expr_Kind
=> Undefined
,
503 Flag1
=> Comments
.Table
(J
).Follows_Empty_Line
,
505 Comments
.Table
(J
).Is_Followed_By_Empty_Line
,
506 Location
=> No_Location
,
507 Directory
=> No_Path
,
508 Variables
=> Empty_Node
,
509 Packages
=> Empty_Node
,
510 Pkg_Id
=> Empty_Package
,
512 Display_Name
=> No_Name
,
514 Path_Name
=> No_Path
,
515 Value
=> Comments
.Table
(J
).Value
,
516 Default
=> Empty_Value
,
517 Field1
=> Empty_Node
,
518 Field2
=> Empty_Node
,
519 Field3
=> Empty_Node
,
520 Field4
=> Empty_Node
,
521 Comments
=> Empty_Node
);
523 -- Link it to the N_Comment_Zones node, if it is the first,
524 -- otherwise to the previous one.
526 if No
(Previous
) then
527 In_Tree
.Project_Nodes
.Table
(Zone
).Field1
:=
528 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
531 In_Tree
.Project_Nodes
.Table
(Previous
).Comments
:=
532 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
535 -- This new node will be the previous one for the next
536 -- N_Comment node, if there is one.
538 Previous
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
541 -- Empty the Comments table after all comments have been processed
543 Comments
.Set_Last
(0);
548 end Default_Project_Node
;
554 function Directory_Of
555 (Node
: Project_Node_Id
;
556 In_Tree
: Project_Node_Tree_Ref
) return Path_Name_Type
562 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
563 return In_Tree
.Project_Nodes
.Table
(Node
).Directory
;
566 -------------------------
567 -- End_Of_Line_Comment --
568 -------------------------
570 function End_Of_Line_Comment
571 (Node
: Project_Node_Id
;
572 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
574 Zone
: Project_Node_Id
:= Empty_Node
;
577 pragma Assert
(Present
(Node
));
578 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
583 return In_Tree
.Project_Nodes
.Table
(Zone
).Value
;
585 end End_Of_Line_Comment
;
587 ------------------------
588 -- Expression_Kind_Of --
589 ------------------------
591 function Expression_Kind_Of
592 (Node
: Project_Node_Id
;
593 In_Tree
: Project_Node_Tree_Ref
) return Variable_Kind
598 and then -- should use Nkind_In here ??? why not???
599 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
601 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
603 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
605 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
606 N_Typed_Variable_Declaration
608 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
610 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
612 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
614 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
616 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
618 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
));
619 return In_Tree
.Project_Nodes
.Table
(Node
).Expr_Kind
;
620 end Expression_Kind_Of
;
626 function Expression_Of
627 (Node
: Project_Node_Id
;
628 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
634 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
635 N_Attribute_Declaration
637 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
638 N_Typed_Variable_Declaration
640 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
641 N_Variable_Declaration
));
643 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
646 -------------------------
647 -- Extended_Project_Of --
648 -------------------------
650 function Extended_Project_Of
651 (Node
: Project_Node_Id
;
652 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
658 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
659 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
660 end Extended_Project_Of
;
662 ------------------------------
663 -- Extended_Project_Path_Of --
664 ------------------------------
666 function Extended_Project_Path_Of
667 (Node
: Project_Node_Id
;
668 In_Tree
: Project_Node_Tree_Ref
) return Path_Name_Type
674 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
675 return Path_Name_Type
(In_Tree
.Project_Nodes
.Table
(Node
).Value
);
676 end Extended_Project_Path_Of
;
678 --------------------------
679 -- Extending_Project_Of --
680 --------------------------
681 function Extending_Project_Of
682 (Node
: Project_Node_Id
;
683 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
689 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
690 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
691 end Extending_Project_Of
;
693 ---------------------------
694 -- External_Reference_Of --
695 ---------------------------
697 function External_Reference_Of
698 (Node
: Project_Node_Id
;
699 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
705 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
706 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
707 end External_Reference_Of
;
709 -------------------------
710 -- External_Default_Of --
711 -------------------------
713 function External_Default_Of
714 (Node
: Project_Node_Id
;
715 In_Tree
: Project_Node_Tree_Ref
)
716 return Project_Node_Id
722 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
723 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
724 end External_Default_Of
;
726 ------------------------
727 -- First_Case_Item_Of --
728 ------------------------
730 function First_Case_Item_Of
731 (Node
: Project_Node_Id
;
732 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
738 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
739 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
740 end First_Case_Item_Of
;
742 ---------------------
743 -- First_Choice_Of --
744 ---------------------
746 function First_Choice_Of
747 (Node
: Project_Node_Id
;
748 In_Tree
: Project_Node_Tree_Ref
)
749 return Project_Node_Id
755 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
756 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
759 -------------------------
760 -- First_Comment_After --
761 -------------------------
763 function First_Comment_After
764 (Node
: Project_Node_Id
;
765 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
767 Zone
: Project_Node_Id
:= Empty_Node
;
769 pragma Assert
(Present
(Node
));
770 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
776 return In_Tree
.Project_Nodes
.Table
(Zone
).Field2
;
778 end First_Comment_After
;
780 -----------------------------
781 -- First_Comment_After_End --
782 -----------------------------
784 function First_Comment_After_End
785 (Node
: Project_Node_Id
;
786 In_Tree
: Project_Node_Tree_Ref
)
787 return Project_Node_Id
789 Zone
: Project_Node_Id
:= Empty_Node
;
792 pragma Assert
(Present
(Node
));
793 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
799 return In_Tree
.Project_Nodes
.Table
(Zone
).Comments
;
801 end First_Comment_After_End
;
803 --------------------------
804 -- First_Comment_Before --
805 --------------------------
807 function First_Comment_Before
808 (Node
: Project_Node_Id
;
809 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
811 Zone
: Project_Node_Id
:= Empty_Node
;
814 pragma Assert
(Present
(Node
));
815 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
821 return In_Tree
.Project_Nodes
.Table
(Zone
).Field1
;
823 end First_Comment_Before
;
825 ------------------------------
826 -- First_Comment_Before_End --
827 ------------------------------
829 function First_Comment_Before_End
830 (Node
: Project_Node_Id
;
831 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
833 Zone
: Project_Node_Id
:= Empty_Node
;
836 pragma Assert
(Present
(Node
));
837 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
843 return In_Tree
.Project_Nodes
.Table
(Zone
).Field3
;
845 end First_Comment_Before_End
;
847 -------------------------------
848 -- First_Declarative_Item_Of --
849 -------------------------------
851 function First_Declarative_Item_Of
852 (Node
: Project_Node_Id
;
853 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
859 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
861 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
863 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
865 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
then
866 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
868 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
870 end First_Declarative_Item_Of
;
872 ------------------------------
873 -- First_Expression_In_List --
874 ------------------------------
876 function First_Expression_In_List
877 (Node
: Project_Node_Id
;
878 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
884 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String_List
);
885 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
886 end First_Expression_In_List
;
888 --------------------------
889 -- First_Literal_String --
890 --------------------------
892 function First_Literal_String
893 (Node
: Project_Node_Id
;
894 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
900 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
901 N_String_Type_Declaration
);
902 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
903 end First_Literal_String
;
905 ----------------------
906 -- First_Package_Of --
907 ----------------------
909 function First_Package_Of
910 (Node
: Project_Node_Id
;
911 In_Tree
: Project_Node_Tree_Ref
) return Package_Declaration_Id
917 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
918 return In_Tree
.Project_Nodes
.Table
(Node
).Packages
;
919 end First_Package_Of
;
921 --------------------------
922 -- First_String_Type_Of --
923 --------------------------
925 function First_String_Type_Of
926 (Node
: Project_Node_Id
;
927 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
933 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
934 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
935 end First_String_Type_Of
;
942 (Node
: Project_Node_Id
;
943 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
949 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
950 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
953 -----------------------
954 -- First_Variable_Of --
955 -----------------------
957 function First_Variable_Of
958 (Node
: Project_Node_Id
;
959 In_Tree
: Project_Node_Tree_Ref
) return Variable_Node_Id
965 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
967 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
969 return In_Tree
.Project_Nodes
.Table
(Node
).Variables
;
970 end First_Variable_Of
;
972 --------------------------
973 -- First_With_Clause_Of --
974 --------------------------
976 function First_With_Clause_Of
977 (Node
: Project_Node_Id
;
978 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
984 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
985 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
986 end First_With_Clause_Of
;
988 ------------------------
989 -- Follows_Empty_Line --
990 ------------------------
992 function Follows_Empty_Line
993 (Node
: Project_Node_Id
;
994 In_Tree
: Project_Node_Tree_Ref
) return Boolean
1000 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
1001 return In_Tree
.Project_Nodes
.Table
(Node
).Flag1
;
1002 end Follows_Empty_Line
;
1008 function Hash
(N
: Project_Node_Id
) return Header_Num
is
1010 return Header_Num
(N
mod Project_Node_Id
(Header_Num
'Last));
1017 procedure Initialize
(Tree
: Project_Node_Tree_Ref
) is
1019 Project_Node_Table
.Init
(Tree
.Project_Nodes
);
1020 Projects_Htable
.Reset
(Tree
.Projects_HT
);
1023 --------------------
1024 -- Override_Flags --
1025 --------------------
1027 procedure Override_Flags
1028 (Self
: in out Environment
;
1029 Flags
: Prj
.Processing_Flags
)
1032 Self
.Flags
:= Flags
;
1039 procedure Initialize
1040 (Self
: out Environment
;
1041 Flags
: Processing_Flags
)
1044 -- Do not reset the external references, in case we are reloading a
1045 -- project, since we want to preserve the current environment. But we
1046 -- still need to ensure that the external references are properly
1049 Prj
.Ext
.Initialize
(Self
.External
);
1051 Self
.Flags
:= Flags
;
1054 -------------------------
1055 -- Initialize_And_Copy --
1056 -------------------------
1058 procedure Initialize_And_Copy
1059 (Self
: out Environment
;
1060 Copy_From
: Environment
)
1063 Self
.Flags
:= Copy_From
.Flags
;
1064 Prj
.Ext
.Initialize
(Self
.External
, Copy_From
=> Copy_From
.External
);
1065 Prj
.Env
.Copy
(From
=> Copy_From
.Project_Path
, To
=> Self
.Project_Path
);
1066 end Initialize_And_Copy
;
1072 procedure Free
(Self
: in out Environment
) is
1074 Prj
.Ext
.Free
(Self
.External
);
1075 Free
(Self
.Project_Path
);
1082 procedure Free
(Proj
: in out Project_Node_Tree_Ref
) is
1083 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
1084 (Project_Node_Tree_Data
, Project_Node_Tree_Ref
);
1086 if Proj
/= null then
1087 Project_Node_Table
.Free
(Proj
.Project_Nodes
);
1088 Projects_Htable
.Reset
(Proj
.Projects_HT
);
1089 Unchecked_Free
(Proj
);
1093 -------------------------------
1094 -- Is_Followed_By_Empty_Line --
1095 -------------------------------
1097 function Is_Followed_By_Empty_Line
1098 (Node
: Project_Node_Id
;
1099 In_Tree
: Project_Node_Tree_Ref
) return Boolean
1105 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
1106 return In_Tree
.Project_Nodes
.Table
(Node
).Flag2
;
1107 end Is_Followed_By_Empty_Line
;
1109 ----------------------
1110 -- Is_Extending_All --
1111 ----------------------
1113 function Is_Extending_All
1114 (Node
: Project_Node_Id
;
1115 In_Tree
: Project_Node_Tree_Ref
) return Boolean
1121 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
1123 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1124 return In_Tree
.Project_Nodes
.Table
(Node
).Flag2
;
1125 end Is_Extending_All
;
1127 -------------------------
1128 -- Is_Not_Last_In_List --
1129 -------------------------
1131 function Is_Not_Last_In_List
1132 (Node
: Project_Node_Id
;
1133 In_Tree
: Project_Node_Tree_Ref
) return Boolean
1139 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
1140 return In_Tree
.Project_Nodes
.Table
(Node
).Flag1
;
1141 end Is_Not_Last_In_List
;
1143 -------------------------------------
1144 -- Imported_Or_Extended_Project_Of --
1145 -------------------------------------
1147 function Imported_Or_Extended_Project_Of
1148 (Project
: Project_Node_Id
;
1149 In_Tree
: Project_Node_Tree_Ref
;
1150 With_Name
: Name_Id
) return Project_Node_Id
1152 With_Clause
: Project_Node_Id
;
1153 Result
: Project_Node_Id
:= Empty_Node
;
1156 -- First check all the imported projects
1158 With_Clause
:= First_With_Clause_Of
(Project
, In_Tree
);
1159 while Present
(With_Clause
) loop
1161 -- Only non limited imported project may be used as prefix of
1162 -- variables or attributes.
1164 Result
:= Non_Limited_Project_Node_Of
(With_Clause
, In_Tree
);
1165 while Present
(Result
) loop
1166 if Name_Of
(Result
, In_Tree
) = With_Name
then
1172 (Project_Declaration_Of
(Result
, In_Tree
), In_Tree
);
1175 With_Clause
:= Next_With_Clause_Of
(With_Clause
, In_Tree
);
1178 -- If it is not an imported project, it might be an extended project
1180 if No
(With_Clause
) then
1185 (Project_Declaration_Of
(Result
, In_Tree
), In_Tree
);
1187 exit when No
(Result
)
1188 or else Name_Of
(Result
, In_Tree
) = With_Name
;
1193 end Imported_Or_Extended_Project_Of
;
1200 (Node
: Project_Node_Id
;
1201 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Kind
1204 pragma Assert
(Present
(Node
));
1205 return In_Tree
.Project_Nodes
.Table
(Node
).Kind
;
1212 function Location_Of
1213 (Node
: Project_Node_Id
;
1214 In_Tree
: Project_Node_Tree_Ref
) return Source_Ptr
1217 pragma Assert
(Present
(Node
));
1218 return In_Tree
.Project_Nodes
.Table
(Node
).Location
;
1226 (Node
: Project_Node_Id
;
1227 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
1230 pragma Assert
(Present
(Node
));
1231 return In_Tree
.Project_Nodes
.Table
(Node
).Name
;
1234 ---------------------
1235 -- Display_Name_Of --
1236 ---------------------
1238 function Display_Name_Of
1239 (Node
: Project_Node_Id
;
1240 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
1246 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1247 return In_Tree
.Project_Nodes
.Table
(Node
).Display_Name
;
1248 end Display_Name_Of
;
1250 --------------------
1251 -- Next_Case_Item --
1252 --------------------
1254 function Next_Case_Item
1255 (Node
: Project_Node_Id
;
1256 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1262 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
1263 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1270 function Next_Comment
1271 (Node
: Project_Node_Id
;
1272 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1278 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
1279 return In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
1282 ---------------------------
1283 -- Next_Declarative_Item --
1284 ---------------------------
1286 function Next_Declarative_Item
1287 (Node
: Project_Node_Id
;
1288 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1294 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
1295 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1296 end Next_Declarative_Item
;
1298 -----------------------------
1299 -- Next_Expression_In_List --
1300 -----------------------------
1302 function Next_Expression_In_List
1303 (Node
: Project_Node_Id
;
1304 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1310 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
1311 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1312 end Next_Expression_In_List
;
1314 -------------------------
1315 -- Next_Literal_String --
1316 -------------------------
1318 function Next_Literal_String
1319 (Node
: Project_Node_Id
;
1320 In_Tree
: Project_Node_Tree_Ref
)
1321 return Project_Node_Id
1327 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
);
1328 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
1329 end Next_Literal_String
;
1331 -----------------------------
1332 -- Next_Package_In_Project --
1333 -----------------------------
1335 function Next_Package_In_Project
1336 (Node
: Project_Node_Id
;
1337 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1343 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1344 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1345 end Next_Package_In_Project
;
1347 ----------------------
1348 -- Next_String_Type --
1349 ----------------------
1351 function Next_String_Type
1352 (Node
: Project_Node_Id
;
1353 In_Tree
: Project_Node_Tree_Ref
)
1354 return Project_Node_Id
1360 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1361 N_String_Type_Declaration
);
1362 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1363 end Next_String_Type
;
1370 (Node
: Project_Node_Id
;
1371 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1376 and then In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
);
1377 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1384 function Next_Variable
1385 (Node
: Project_Node_Id
;
1386 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1392 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1393 N_Typed_Variable_Declaration
1395 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1396 N_Variable_Declaration
));
1398 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1401 -------------------------
1402 -- Next_With_Clause_Of --
1403 -------------------------
1405 function Next_With_Clause_Of
1406 (Node
: Project_Node_Id
;
1407 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1413 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
1414 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1415 end Next_With_Clause_Of
;
1421 function No
(Node
: Project_Node_Id
) return Boolean is
1423 return Node
= Empty_Node
;
1426 ---------------------------------
1427 -- Non_Limited_Project_Node_Of --
1428 ---------------------------------
1430 function Non_Limited_Project_Node_Of
1431 (Node
: Project_Node_Id
;
1432 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1438 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1439 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1440 end Non_Limited_Project_Node_Of
;
1446 function Package_Id_Of
1447 (Node
: Project_Node_Id
;
1448 In_Tree
: Project_Node_Tree_Ref
) return Package_Node_Id
1454 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1455 return In_Tree
.Project_Nodes
.Table
(Node
).Pkg_Id
;
1458 ---------------------
1459 -- Package_Node_Of --
1460 ---------------------
1462 function Package_Node_Of
1463 (Node
: Project_Node_Id
;
1464 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
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
).Field2
;
1474 end Package_Node_Of
;
1480 function Path_Name_Of
1481 (Node
: Project_Node_Id
;
1482 In_Tree
: Project_Node_Tree_Ref
) return Path_Name_Type
1488 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
1490 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1491 return In_Tree
.Project_Nodes
.Table
(Node
).Path_Name
;
1498 function Present
(Node
: Project_Node_Id
) return Boolean is
1500 return Node
/= Empty_Node
;
1503 ----------------------------
1504 -- Project_Declaration_Of --
1505 ----------------------------
1507 function Project_Declaration_Of
1508 (Node
: Project_Node_Id
;
1509 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1515 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1516 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1517 end Project_Declaration_Of
;
1519 --------------------------
1520 -- Project_Qualifier_Of --
1521 --------------------------
1523 function Project_Qualifier_Of
1524 (Node
: Project_Node_Id
;
1525 In_Tree
: Project_Node_Tree_Ref
) return Project_Qualifier
1531 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1532 return In_Tree
.Project_Nodes
.Table
(Node
).Qualifier
;
1533 end Project_Qualifier_Of
;
1535 -----------------------
1536 -- Parent_Project_Of --
1537 -----------------------
1539 function Parent_Project_Of
1540 (Node
: Project_Node_Id
;
1541 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1547 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1548 return In_Tree
.Project_Nodes
.Table
(Node
).Field4
;
1549 end Parent_Project_Of
;
1551 -------------------------------------------
1552 -- Project_File_Includes_Unkept_Comments --
1553 -------------------------------------------
1555 function Project_File_Includes_Unkept_Comments
1556 (Node
: Project_Node_Id
;
1557 In_Tree
: Project_Node_Tree_Ref
) return Boolean
1559 Declaration
: constant Project_Node_Id
:=
1560 Project_Declaration_Of
(Node
, In_Tree
);
1562 return In_Tree
.Project_Nodes
.Table
(Declaration
).Flag1
;
1563 end Project_File_Includes_Unkept_Comments
;
1565 ---------------------
1566 -- Project_Node_Of --
1567 ---------------------
1569 function Project_Node_Of
1570 (Node
: Project_Node_Id
;
1571 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1577 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
1579 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1581 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1582 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
1583 end Project_Node_Of
;
1585 -----------------------------------
1586 -- Project_Of_Renamed_Package_Of --
1587 -----------------------------------
1589 function Project_Of_Renamed_Package_Of
1590 (Node
: Project_Node_Id
;
1591 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1597 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1598 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
1599 end Project_Of_Renamed_Package_Of
;
1601 --------------------------
1602 -- Remove_Next_End_Node --
1603 --------------------------
1605 procedure Remove_Next_End_Node
is
1607 Next_End_Nodes
.Decrement_Last
;
1608 end Remove_Next_End_Node
;
1614 procedure Reset_State
is
1616 End_Of_Line_Node
:= Empty_Node
;
1617 Previous_Line_Node
:= Empty_Node
;
1618 Previous_End_Node
:= Empty_Node
;
1619 Unkept_Comments
:= False;
1620 Comments
.Set_Last
(0);
1623 ----------------------
1624 -- Restore_And_Free --
1625 ----------------------
1627 procedure Restore_And_Free
(S
: in out Comment_State
) is
1628 procedure Unchecked_Free
is new
1629 Ada
.Unchecked_Deallocation
(Comment_Array
, Comments_Ptr
);
1632 End_Of_Line_Node
:= S
.End_Of_Line_Node
;
1633 Previous_Line_Node
:= S
.Previous_Line_Node
;
1634 Previous_End_Node
:= S
.Previous_End_Node
;
1635 Next_End_Nodes
.Set_Last
(0);
1636 Unkept_Comments
:= S
.Unkept_Comments
;
1638 Comments
.Set_Last
(0);
1640 for J
in S
.Comments
'Range loop
1641 Comments
.Increment_Last
;
1642 Comments
.Table
(Comments
.Last
) := S
.Comments
(J
);
1645 Unchecked_Free
(S
.Comments
);
1646 end Restore_And_Free
;
1652 procedure Save
(S
: out Comment_State
) is
1653 Cmts
: constant Comments_Ptr
:= new Comment_Array
(1 .. Comments
.Last
);
1656 for J
in 1 .. Comments
.Last
loop
1657 Cmts
(J
) := Comments
.Table
(J
);
1661 (End_Of_Line_Node
=> End_Of_Line_Node
,
1662 Previous_Line_Node
=> Previous_Line_Node
,
1663 Previous_End_Node
=> Previous_End_Node
,
1664 Unkept_Comments
=> Unkept_Comments
,
1672 procedure Scan
(In_Tree
: Project_Node_Tree_Ref
) is
1673 Empty_Line
: Boolean := False;
1676 -- If there are comments, then they will not be kept. Set the flag and
1677 -- clear the comments.
1679 if Comments
.Last
> 0 then
1680 Unkept_Comments
:= True;
1681 Comments
.Set_Last
(0);
1684 -- Loop until a token other that End_Of_Line or Comment is found
1687 Prj
.Err
.Scanner
.Scan
;
1690 when Tok_End_Of_Line
=>
1691 if Prev_Token
= Tok_End_Of_Line
then
1694 if Comments
.Last
> 0 then
1695 Comments
.Table
(Comments
.Last
).Is_Followed_By_Empty_Line
1701 -- If this is a line comment, add it to the comment table
1703 if Prev_Token
= Tok_End_Of_Line
1704 or else Prev_Token
= No_Token
1706 Comments
.Increment_Last
;
1707 Comments
.Table
(Comments
.Last
) :=
1708 (Value
=> Comment_Id
,
1709 Follows_Empty_Line
=> Empty_Line
,
1710 Is_Followed_By_Empty_Line
=> False);
1712 -- Otherwise, it is an end of line comment. If there is an
1713 -- end of line node specified, associate the comment with
1716 elsif Present
(End_Of_Line_Node
) then
1718 Zones
: constant Project_Node_Id
:=
1719 Comment_Zones_Of
(End_Of_Line_Node
, In_Tree
);
1721 In_Tree
.Project_Nodes
.Table
(Zones
).Value
:= Comment_Id
;
1724 -- Otherwise, this end of line node cannot be kept
1727 Unkept_Comments
:= True;
1728 Comments
.Set_Last
(0);
1731 Empty_Line
:= False;
1735 -- If there are comments, where the first comment is not
1736 -- following an empty line, put the initial uninterrupted
1737 -- comment zone with the node of the preceding line (either
1738 -- a Previous_Line or a Previous_End node), if any.
1740 if Comments
.Last
> 0 and then
1741 not Comments
.Table
(1).Follows_Empty_Line
1743 if Present
(Previous_Line_Node
) then
1745 (To
=> Previous_Line_Node
,
1747 In_Tree
=> In_Tree
);
1749 elsif Present
(Previous_End_Node
) then
1751 (To
=> Previous_End_Node
,
1753 In_Tree
=> In_Tree
);
1757 -- If there are still comments and the token is "end", then
1758 -- put these comments with the Next_End node, if any;
1759 -- otherwise, these comments cannot be kept. Always clear
1762 if Comments
.Last
> 0 and then Token
= Tok_End
then
1763 if Next_End_Nodes
.Last
> 0 then
1765 (To
=> Next_End_Nodes
.Table
(Next_End_Nodes
.Last
),
1766 Where
=> Before_End
,
1767 In_Tree
=> In_Tree
);
1770 Unkept_Comments
:= True;
1773 Comments
.Set_Last
(0);
1776 -- Reset the End_Of_Line, Previous_Line and Previous_End nodes
1777 -- so that they are not used again.
1779 End_Of_Line_Node
:= Empty_Node
;
1780 Previous_Line_Node
:= Empty_Node
;
1781 Previous_End_Node
:= Empty_Node
;
1790 ------------------------------------
1791 -- Set_Associative_Array_Index_Of --
1792 ------------------------------------
1794 procedure Set_Associative_Array_Index_Of
1795 (Node
: Project_Node_Id
;
1796 In_Tree
: Project_Node_Tree_Ref
;
1803 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1805 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1806 In_Tree
.Project_Nodes
.Table
(Node
).Value
:= To
;
1807 end Set_Associative_Array_Index_Of
;
1809 --------------------------------
1810 -- Set_Associative_Package_Of --
1811 --------------------------------
1813 procedure Set_Associative_Package_Of
1814 (Node
: Project_Node_Id
;
1815 In_Tree
: Project_Node_Tree_Ref
;
1816 To
: Project_Node_Id
)
1822 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
);
1823 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
1824 end Set_Associative_Package_Of
;
1826 --------------------------------
1827 -- Set_Associative_Project_Of --
1828 --------------------------------
1830 procedure Set_Associative_Project_Of
1831 (Node
: Project_Node_Id
;
1832 In_Tree
: Project_Node_Tree_Ref
;
1833 To
: Project_Node_Id
)
1839 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1840 N_Attribute_Declaration
));
1841 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
1842 end Set_Associative_Project_Of
;
1844 --------------------------
1845 -- Set_Case_Insensitive --
1846 --------------------------
1848 procedure Set_Case_Insensitive
1849 (Node
: Project_Node_Id
;
1850 In_Tree
: Project_Node_Tree_Ref
;
1857 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1859 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1860 In_Tree
.Project_Nodes
.Table
(Node
).Flag1
:= To
;
1861 end Set_Case_Insensitive
;
1863 ------------------------------------
1864 -- Set_Case_Variable_Reference_Of --
1865 ------------------------------------
1867 procedure Set_Case_Variable_Reference_Of
1868 (Node
: Project_Node_Id
;
1869 In_Tree
: Project_Node_Tree_Ref
;
1870 To
: Project_Node_Id
)
1876 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
1877 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1878 end Set_Case_Variable_Reference_Of
;
1880 ---------------------------
1881 -- Set_Current_Item_Node --
1882 ---------------------------
1884 procedure Set_Current_Item_Node
1885 (Node
: Project_Node_Id
;
1886 In_Tree
: Project_Node_Tree_Ref
;
1887 To
: Project_Node_Id
)
1893 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
1894 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1895 end Set_Current_Item_Node
;
1897 ----------------------
1898 -- Set_Current_Term --
1899 ----------------------
1901 procedure Set_Current_Term
1902 (Node
: Project_Node_Id
;
1903 In_Tree
: Project_Node_Tree_Ref
;
1904 To
: Project_Node_Id
)
1910 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
);
1911 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1912 end Set_Current_Term
;
1914 --------------------
1915 -- Set_Default_Of --
1916 --------------------
1918 procedure Set_Default_Of
1919 (Node
: Project_Node_Id
;
1920 In_Tree
: Project_Node_Tree_Ref
;
1921 To
: Attribute_Default_Value
)
1927 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
);
1928 In_Tree
.Project_Nodes
.Table
(Node
).Default
:= To
;
1931 ----------------------
1932 -- Set_Directory_Of --
1933 ----------------------
1935 procedure Set_Directory_Of
1936 (Node
: Project_Node_Id
;
1937 In_Tree
: Project_Node_Tree_Ref
;
1938 To
: Path_Name_Type
)
1944 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1945 In_Tree
.Project_Nodes
.Table
(Node
).Directory
:= To
;
1946 end Set_Directory_Of
;
1948 ---------------------
1949 -- Set_End_Of_Line --
1950 ---------------------
1952 procedure Set_End_Of_Line
(To
: Project_Node_Id
) is
1954 End_Of_Line_Node
:= To
;
1955 end Set_End_Of_Line
;
1957 ----------------------------
1958 -- Set_Expression_Kind_Of --
1959 ----------------------------
1961 procedure Set_Expression_Kind_Of
1962 (Node
: Project_Node_Id
;
1963 In_Tree
: Project_Node_Tree_Ref
;
1969 and then -- should use Nkind_In here ??? why not???
1970 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
1972 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1974 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
1976 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1977 N_Typed_Variable_Declaration
1979 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
1981 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
1983 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
1985 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1987 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
1989 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
));
1990 In_Tree
.Project_Nodes
.Table
(Node
).Expr_Kind
:= To
;
1991 end Set_Expression_Kind_Of
;
1993 -----------------------
1994 -- Set_Expression_Of --
1995 -----------------------
1997 procedure Set_Expression_Of
1998 (Node
: Project_Node_Id
;
1999 In_Tree
: Project_Node_Tree_Ref
;
2000 To
: Project_Node_Id
)
2006 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2007 N_Attribute_Declaration
2009 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2010 N_Typed_Variable_Declaration
2012 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2013 N_Variable_Declaration
));
2014 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2015 end Set_Expression_Of
;
2017 -------------------------------
2018 -- Set_External_Reference_Of --
2019 -------------------------------
2021 procedure Set_External_Reference_Of
2022 (Node
: Project_Node_Id
;
2023 In_Tree
: Project_Node_Tree_Ref
;
2024 To
: Project_Node_Id
)
2030 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
2031 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2032 end Set_External_Reference_Of
;
2034 -----------------------------
2035 -- Set_External_Default_Of --
2036 -----------------------------
2038 procedure Set_External_Default_Of
2039 (Node
: Project_Node_Id
;
2040 In_Tree
: Project_Node_Tree_Ref
;
2041 To
: Project_Node_Id
)
2047 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
2048 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2049 end Set_External_Default_Of
;
2051 ----------------------------
2052 -- Set_First_Case_Item_Of --
2053 ----------------------------
2055 procedure Set_First_Case_Item_Of
2056 (Node
: Project_Node_Id
;
2057 In_Tree
: Project_Node_Tree_Ref
;
2058 To
: Project_Node_Id
)
2064 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
2065 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2066 end Set_First_Case_Item_Of
;
2068 -------------------------
2069 -- Set_First_Choice_Of --
2070 -------------------------
2072 procedure Set_First_Choice_Of
2073 (Node
: Project_Node_Id
;
2074 In_Tree
: Project_Node_Tree_Ref
;
2075 To
: Project_Node_Id
)
2081 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
2082 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2083 end Set_First_Choice_Of
;
2085 -----------------------------
2086 -- Set_First_Comment_After --
2087 -----------------------------
2089 procedure Set_First_Comment_After
2090 (Node
: Project_Node_Id
;
2091 In_Tree
: Project_Node_Tree_Ref
;
2092 To
: Project_Node_Id
)
2094 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
2096 In_Tree
.Project_Nodes
.Table
(Zone
).Field2
:= To
;
2097 end Set_First_Comment_After
;
2099 ---------------------------------
2100 -- Set_First_Comment_After_End --
2101 ---------------------------------
2103 procedure Set_First_Comment_After_End
2104 (Node
: Project_Node_Id
;
2105 In_Tree
: Project_Node_Tree_Ref
;
2106 To
: Project_Node_Id
)
2108 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
2110 In_Tree
.Project_Nodes
.Table
(Zone
).Comments
:= To
;
2111 end Set_First_Comment_After_End
;
2113 ------------------------------
2114 -- Set_First_Comment_Before --
2115 ------------------------------
2117 procedure Set_First_Comment_Before
2118 (Node
: Project_Node_Id
;
2119 In_Tree
: Project_Node_Tree_Ref
;
2120 To
: Project_Node_Id
)
2122 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
2124 In_Tree
.Project_Nodes
.Table
(Zone
).Field1
:= To
;
2125 end Set_First_Comment_Before
;
2127 ----------------------------------
2128 -- Set_First_Comment_Before_End --
2129 ----------------------------------
2131 procedure Set_First_Comment_Before_End
2132 (Node
: Project_Node_Id
;
2133 In_Tree
: Project_Node_Tree_Ref
;
2134 To
: Project_Node_Id
)
2136 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
2138 In_Tree
.Project_Nodes
.Table
(Zone
).Field2
:= To
;
2139 end Set_First_Comment_Before_End
;
2141 ------------------------
2142 -- Set_Next_Case_Item --
2143 ------------------------
2145 procedure Set_Next_Case_Item
2146 (Node
: Project_Node_Id
;
2147 In_Tree
: Project_Node_Tree_Ref
;
2148 To
: Project_Node_Id
)
2154 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
2155 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2156 end Set_Next_Case_Item
;
2158 ----------------------
2159 -- Set_Next_Comment --
2160 ----------------------
2162 procedure Set_Next_Comment
2163 (Node
: Project_Node_Id
;
2164 In_Tree
: Project_Node_Tree_Ref
;
2165 To
: Project_Node_Id
)
2171 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
2172 In_Tree
.Project_Nodes
.Table
(Node
).Comments
:= To
;
2173 end Set_Next_Comment
;
2175 -----------------------------------
2176 -- Set_First_Declarative_Item_Of --
2177 -----------------------------------
2179 procedure Set_First_Declarative_Item_Of
2180 (Node
: Project_Node_Id
;
2181 In_Tree
: Project_Node_Tree_Ref
;
2182 To
: Project_Node_Id
)
2188 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
2190 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
2192 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
2194 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
then
2195 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2197 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2199 end Set_First_Declarative_Item_Of
;
2201 ----------------------------------
2202 -- Set_First_Expression_In_List --
2203 ----------------------------------
2205 procedure Set_First_Expression_In_List
2206 (Node
: Project_Node_Id
;
2207 In_Tree
: Project_Node_Tree_Ref
;
2208 To
: Project_Node_Id
)
2214 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String_List
);
2215 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2216 end Set_First_Expression_In_List
;
2218 ------------------------------
2219 -- Set_First_Literal_String --
2220 ------------------------------
2222 procedure Set_First_Literal_String
2223 (Node
: Project_Node_Id
;
2224 In_Tree
: Project_Node_Tree_Ref
;
2225 To
: Project_Node_Id
)
2231 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2232 N_String_Type_Declaration
);
2233 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2234 end Set_First_Literal_String
;
2236 --------------------------
2237 -- Set_First_Package_Of --
2238 --------------------------
2240 procedure Set_First_Package_Of
2241 (Node
: Project_Node_Id
;
2242 In_Tree
: Project_Node_Tree_Ref
;
2243 To
: Package_Declaration_Id
)
2249 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2250 In_Tree
.Project_Nodes
.Table
(Node
).Packages
:= To
;
2251 end Set_First_Package_Of
;
2253 ------------------------------
2254 -- Set_First_String_Type_Of --
2255 ------------------------------
2257 procedure Set_First_String_Type_Of
2258 (Node
: Project_Node_Id
;
2259 In_Tree
: Project_Node_Tree_Ref
;
2260 To
: Project_Node_Id
)
2266 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2267 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2268 end Set_First_String_Type_Of
;
2270 --------------------
2271 -- Set_First_Term --
2272 --------------------
2274 procedure Set_First_Term
2275 (Node
: Project_Node_Id
;
2276 In_Tree
: Project_Node_Tree_Ref
;
2277 To
: Project_Node_Id
)
2283 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
2284 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2287 ---------------------------
2288 -- Set_First_Variable_Of --
2289 ---------------------------
2291 procedure Set_First_Variable_Of
2292 (Node
: Project_Node_Id
;
2293 In_Tree
: Project_Node_Tree_Ref
;
2294 To
: Variable_Node_Id
)
2300 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
2302 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
2303 In_Tree
.Project_Nodes
.Table
(Node
).Variables
:= To
;
2304 end Set_First_Variable_Of
;
2306 ------------------------------
2307 -- Set_First_With_Clause_Of --
2308 ------------------------------
2310 procedure Set_First_With_Clause_Of
2311 (Node
: Project_Node_Id
;
2312 In_Tree
: Project_Node_Tree_Ref
;
2313 To
: Project_Node_Id
)
2319 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2320 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2321 end Set_First_With_Clause_Of
;
2323 --------------------------
2324 -- Set_Is_Extending_All --
2325 --------------------------
2327 procedure Set_Is_Extending_All
2328 (Node
: Project_Node_Id
;
2329 In_Tree
: Project_Node_Tree_Ref
)
2335 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
2337 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
2338 In_Tree
.Project_Nodes
.Table
(Node
).Flag2
:= True;
2339 end Set_Is_Extending_All
;
2341 -----------------------------
2342 -- Set_Is_Not_Last_In_List --
2343 -----------------------------
2345 procedure Set_Is_Not_Last_In_List
2346 (Node
: Project_Node_Id
;
2347 In_Tree
: Project_Node_Tree_Ref
)
2352 and then In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
2353 In_Tree
.Project_Nodes
.Table
(Node
).Flag1
:= True;
2354 end Set_Is_Not_Last_In_List
;
2360 procedure Set_Kind_Of
2361 (Node
: Project_Node_Id
;
2362 In_Tree
: Project_Node_Tree_Ref
;
2363 To
: Project_Node_Kind
)
2366 pragma Assert
(Present
(Node
));
2367 In_Tree
.Project_Nodes
.Table
(Node
).Kind
:= To
;
2370 ---------------------
2371 -- Set_Location_Of --
2372 ---------------------
2374 procedure Set_Location_Of
2375 (Node
: Project_Node_Id
;
2376 In_Tree
: Project_Node_Tree_Ref
;
2380 pragma Assert
(Present
(Node
));
2381 In_Tree
.Project_Nodes
.Table
(Node
).Location
:= To
;
2382 end Set_Location_Of
;
2384 -----------------------------
2385 -- Set_Extended_Project_Of --
2386 -----------------------------
2388 procedure Set_Extended_Project_Of
2389 (Node
: Project_Node_Id
;
2390 In_Tree
: Project_Node_Tree_Ref
;
2391 To
: Project_Node_Id
)
2397 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
2398 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2399 end Set_Extended_Project_Of
;
2401 ----------------------------------
2402 -- Set_Extended_Project_Path_Of --
2403 ----------------------------------
2405 procedure Set_Extended_Project_Path_Of
2406 (Node
: Project_Node_Id
;
2407 In_Tree
: Project_Node_Tree_Ref
;
2408 To
: Path_Name_Type
)
2414 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2415 In_Tree
.Project_Nodes
.Table
(Node
).Value
:= Name_Id
(To
);
2416 end Set_Extended_Project_Path_Of
;
2418 ------------------------------
2419 -- Set_Extending_Project_Of --
2420 ------------------------------
2422 procedure Set_Extending_Project_Of
2423 (Node
: Project_Node_Id
;
2424 In_Tree
: Project_Node_Tree_Ref
;
2425 To
: Project_Node_Id
)
2431 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
2432 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2433 end Set_Extending_Project_Of
;
2439 procedure Set_Name_Of
2440 (Node
: Project_Node_Id
;
2441 In_Tree
: Project_Node_Tree_Ref
;
2445 pragma Assert
(Present
(Node
));
2446 In_Tree
.Project_Nodes
.Table
(Node
).Name
:= To
;
2449 -------------------------
2450 -- Set_Display_Name_Of --
2451 -------------------------
2453 procedure Set_Display_Name_Of
2454 (Node
: Project_Node_Id
;
2455 In_Tree
: Project_Node_Tree_Ref
;
2461 and then In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2462 In_Tree
.Project_Nodes
.Table
(Node
).Display_Name
:= To
;
2463 end Set_Display_Name_Of
;
2465 -------------------------------
2466 -- Set_Next_Declarative_Item --
2467 -------------------------------
2469 procedure Set_Next_Declarative_Item
2470 (Node
: Project_Node_Id
;
2471 In_Tree
: Project_Node_Tree_Ref
;
2472 To
: Project_Node_Id
)
2478 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
2479 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2480 end Set_Next_Declarative_Item
;
2482 -----------------------
2483 -- Set_Next_End_Node --
2484 -----------------------
2486 procedure Set_Next_End_Node
(To
: Project_Node_Id
) is
2488 Next_End_Nodes
.Increment_Last
;
2489 Next_End_Nodes
.Table
(Next_End_Nodes
.Last
) := To
;
2490 end Set_Next_End_Node
;
2492 ---------------------------------
2493 -- Set_Next_Expression_In_List --
2494 ---------------------------------
2496 procedure Set_Next_Expression_In_List
2497 (Node
: Project_Node_Id
;
2498 In_Tree
: Project_Node_Tree_Ref
;
2499 To
: Project_Node_Id
)
2505 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
2506 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2507 end Set_Next_Expression_In_List
;
2509 -----------------------------
2510 -- Set_Next_Literal_String --
2511 -----------------------------
2513 procedure Set_Next_Literal_String
2514 (Node
: Project_Node_Id
;
2515 In_Tree
: Project_Node_Tree_Ref
;
2516 To
: Project_Node_Id
)
2522 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
);
2523 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2524 end Set_Next_Literal_String
;
2526 ---------------------------------
2527 -- Set_Next_Package_In_Project --
2528 ---------------------------------
2530 procedure Set_Next_Package_In_Project
2531 (Node
: Project_Node_Id
;
2532 In_Tree
: Project_Node_Tree_Ref
;
2533 To
: Project_Node_Id
)
2539 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2540 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2541 end Set_Next_Package_In_Project
;
2543 --------------------------
2544 -- Set_Next_String_Type --
2545 --------------------------
2547 procedure Set_Next_String_Type
2548 (Node
: Project_Node_Id
;
2549 In_Tree
: Project_Node_Tree_Ref
;
2550 To
: Project_Node_Id
)
2556 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2557 N_String_Type_Declaration
);
2558 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2559 end Set_Next_String_Type
;
2565 procedure Set_Next_Term
2566 (Node
: Project_Node_Id
;
2567 In_Tree
: Project_Node_Tree_Ref
;
2568 To
: Project_Node_Id
)
2574 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
);
2575 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2578 -----------------------
2579 -- Set_Next_Variable --
2580 -----------------------
2582 procedure Set_Next_Variable
2583 (Node
: Project_Node_Id
;
2584 In_Tree
: Project_Node_Tree_Ref
;
2585 To
: Project_Node_Id
)
2591 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2592 N_Typed_Variable_Declaration
2594 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2595 N_Variable_Declaration
));
2596 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2597 end Set_Next_Variable
;
2599 -----------------------------
2600 -- Set_Next_With_Clause_Of --
2601 -----------------------------
2603 procedure Set_Next_With_Clause_Of
2604 (Node
: Project_Node_Id
;
2605 In_Tree
: Project_Node_Tree_Ref
;
2606 To
: Project_Node_Id
)
2612 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
2613 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2614 end Set_Next_With_Clause_Of
;
2616 -----------------------
2617 -- Set_Package_Id_Of --
2618 -----------------------
2620 procedure Set_Package_Id_Of
2621 (Node
: Project_Node_Id
;
2622 In_Tree
: Project_Node_Tree_Ref
;
2623 To
: Package_Node_Id
)
2629 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2630 In_Tree
.Project_Nodes
.Table
(Node
).Pkg_Id
:= To
;
2631 end Set_Package_Id_Of
;
2633 -------------------------
2634 -- Set_Package_Node_Of --
2635 -------------------------
2637 procedure Set_Package_Node_Of
2638 (Node
: Project_Node_Id
;
2639 In_Tree
: Project_Node_Tree_Ref
;
2640 To
: Project_Node_Id
)
2646 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2648 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
2649 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2650 end Set_Package_Node_Of
;
2652 ----------------------
2653 -- Set_Path_Name_Of --
2654 ----------------------
2656 procedure Set_Path_Name_Of
2657 (Node
: Project_Node_Id
;
2658 In_Tree
: Project_Node_Tree_Ref
;
2659 To
: Path_Name_Type
)
2665 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
2667 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
2668 In_Tree
.Project_Nodes
.Table
(Node
).Path_Name
:= To
;
2669 end Set_Path_Name_Of
;
2671 ---------------------------
2672 -- Set_Previous_End_Node --
2673 ---------------------------
2674 procedure Set_Previous_End_Node
(To
: Project_Node_Id
) is
2676 Previous_End_Node
:= To
;
2677 end Set_Previous_End_Node
;
2679 ----------------------------
2680 -- Set_Previous_Line_Node --
2681 ----------------------------
2683 procedure Set_Previous_Line_Node
(To
: Project_Node_Id
) is
2685 Previous_Line_Node
:= To
;
2686 end Set_Previous_Line_Node
;
2688 --------------------------------
2689 -- Set_Project_Declaration_Of --
2690 --------------------------------
2692 procedure Set_Project_Declaration_Of
2693 (Node
: Project_Node_Id
;
2694 In_Tree
: Project_Node_Tree_Ref
;
2695 To
: Project_Node_Id
)
2701 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2702 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2703 end Set_Project_Declaration_Of
;
2705 ------------------------------
2706 -- Set_Project_Qualifier_Of --
2707 ------------------------------
2709 procedure Set_Project_Qualifier_Of
2710 (Node
: Project_Node_Id
;
2711 In_Tree
: Project_Node_Tree_Ref
;
2712 To
: Project_Qualifier
)
2717 and then In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2718 In_Tree
.Project_Nodes
.Table
(Node
).Qualifier
:= To
;
2719 end Set_Project_Qualifier_Of
;
2721 ---------------------------
2722 -- Set_Parent_Project_Of --
2723 ---------------------------
2725 procedure Set_Parent_Project_Of
2726 (Node
: Project_Node_Id
;
2727 In_Tree
: Project_Node_Tree_Ref
;
2728 To
: Project_Node_Id
)
2733 and then In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2734 In_Tree
.Project_Nodes
.Table
(Node
).Field4
:= To
;
2735 end Set_Parent_Project_Of
;
2737 -----------------------------------------------
2738 -- Set_Project_File_Includes_Unkept_Comments --
2739 -----------------------------------------------
2741 procedure Set_Project_File_Includes_Unkept_Comments
2742 (Node
: Project_Node_Id
;
2743 In_Tree
: Project_Node_Tree_Ref
;
2746 Declaration
: constant Project_Node_Id
:=
2747 Project_Declaration_Of
(Node
, In_Tree
);
2749 In_Tree
.Project_Nodes
.Table
(Declaration
).Flag1
:= To
;
2750 end Set_Project_File_Includes_Unkept_Comments
;
2752 -------------------------
2753 -- Set_Project_Node_Of --
2754 -------------------------
2756 procedure Set_Project_Node_Of
2757 (Node
: Project_Node_Id
;
2758 In_Tree
: Project_Node_Tree_Ref
;
2759 To
: Project_Node_Id
;
2760 Limited_With
: Boolean := False)
2766 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2768 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2770 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
2771 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2773 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2774 and then not Limited_With
2776 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2778 end Set_Project_Node_Of
;
2780 ---------------------------------------
2781 -- Set_Project_Of_Renamed_Package_Of --
2782 ---------------------------------------
2784 procedure Set_Project_Of_Renamed_Package_Of
2785 (Node
: Project_Node_Id
;
2786 In_Tree
: Project_Node_Tree_Ref
;
2787 To
: Project_Node_Id
)
2793 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2794 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2795 end Set_Project_Of_Renamed_Package_Of
;
2797 -------------------------
2798 -- Set_Source_Index_Of --
2799 -------------------------
2801 procedure Set_Source_Index_Of
2802 (Node
: Project_Node_Id
;
2803 In_Tree
: Project_Node_Tree_Ref
;
2810 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
2812 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2813 N_Attribute_Declaration
));
2814 In_Tree
.Project_Nodes
.Table
(Node
).Src_Index
:= To
;
2815 end Set_Source_Index_Of
;
2817 ------------------------
2818 -- Set_String_Type_Of --
2819 ------------------------
2821 procedure Set_String_Type_Of
2822 (Node
: Project_Node_Id
;
2823 In_Tree
: Project_Node_Tree_Ref
;
2824 To
: Project_Node_Id
)
2830 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2831 N_Variable_Reference
2833 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2834 N_Typed_Variable_Declaration
)
2836 In_Tree
.Project_Nodes
.Table
(To
).Kind
= N_String_Type_Declaration
);
2838 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
then
2839 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2841 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2843 end Set_String_Type_Of
;
2845 -------------------------
2846 -- Set_String_Value_Of --
2847 -------------------------
2849 procedure Set_String_Value_Of
2850 (Node
: Project_Node_Id
;
2851 In_Tree
: Project_Node_Tree_Ref
;
2858 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2860 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
2862 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
));
2863 In_Tree
.Project_Nodes
.Table
(Node
).Value
:= To
;
2864 end Set_String_Value_Of
;
2866 ---------------------
2867 -- Source_Index_Of --
2868 ---------------------
2870 function Source_Index_Of
2871 (Node
: Project_Node_Id
;
2872 In_Tree
: Project_Node_Tree_Ref
) return Int
2878 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
2880 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2881 N_Attribute_Declaration
));
2882 return In_Tree
.Project_Nodes
.Table
(Node
).Src_Index
;
2883 end Source_Index_Of
;
2885 --------------------
2886 -- String_Type_Of --
2887 --------------------
2889 function String_Type_Of
2890 (Node
: Project_Node_Id
;
2891 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
2897 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2898 N_Variable_Reference
2900 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2901 N_Typed_Variable_Declaration
));
2903 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
then
2904 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
2906 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
2910 ---------------------
2911 -- String_Value_Of --
2912 ---------------------
2914 function String_Value_Of
2915 (Node
: Project_Node_Id
;
2916 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
2922 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2924 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
2926 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
));
2927 return In_Tree
.Project_Nodes
.Table
(Node
).Value
;
2928 end String_Value_Of
;
2930 --------------------
2931 -- Value_Is_Valid --
2932 --------------------
2934 function Value_Is_Valid
2935 (For_Typed_Variable
: Project_Node_Id
;
2936 In_Tree
: Project_Node_Tree_Ref
;
2937 Value
: Name_Id
) return Boolean
2941 (Present
(For_Typed_Variable
)
2943 (In_Tree
.Project_Nodes
.Table
(For_Typed_Variable
).Kind
=
2944 N_Typed_Variable_Declaration
));
2947 Current_String
: Project_Node_Id
:=
2948 First_Literal_String
2949 (String_Type_Of
(For_Typed_Variable
, In_Tree
),
2953 while Present
(Current_String
)
2955 String_Value_Of
(Current_String
, In_Tree
) /= Value
2958 Next_Literal_String
(Current_String
, In_Tree
);
2961 return Present
(Current_String
);
2966 -------------------------------
2967 -- There_Are_Unkept_Comments --
2968 -------------------------------
2970 function There_Are_Unkept_Comments
return Boolean is
2972 return Unkept_Comments
;
2973 end There_Are_Unkept_Comments
;
2975 --------------------
2976 -- Create_Project --
2977 --------------------
2979 function Create_Project
2980 (In_Tree
: Project_Node_Tree_Ref
;
2982 Full_Path
: Path_Name_Type
;
2983 Is_Config_File
: Boolean := False) return Project_Node_Id
2985 Project
: Project_Node_Id
;
2986 Qualifier
: Project_Qualifier
:= Unspecified
;
2988 Project
:= Default_Project_Node
(In_Tree
, N_Project
);
2989 Set_Name_Of
(Project
, In_Tree
, Name
);
2990 Set_Display_Name_Of
(Project
, In_Tree
, Name
);
2993 Path_Name_Type
(Get_Directory
(File_Name_Type
(Full_Path
))));
2994 Set_Path_Name_Of
(Project
, In_Tree
, Full_Path
);
2996 Set_Project_Declaration_Of
2998 Default_Project_Node
(In_Tree
, N_Project_Declaration
));
3000 if Is_Config_File
then
3001 Qualifier
:= Configuration
;
3004 if not Is_Config_File
then
3005 Prj
.Tree
.Tree_Private_Part
.Projects_Htable
.Set
3006 (In_Tree
.Projects_HT
,
3008 Prj
.Tree
.Tree_Private_Part
.Project_Name_And_Node
'
3010 Resolved_Path => No_Path,
3013 From_Extended => False,
3014 Proj_Qualifier => Qualifier));
3024 procedure Add_At_End
3025 (Tree : Project_Node_Tree_Ref;
3026 Parent : Project_Node_Id;
3027 Expr : Project_Node_Id;
3028 Add_Before_First_Pkg : Boolean := False;
3029 Add_Before_First_Case : Boolean := False)
3031 Real_Parent : Project_Node_Id;
3032 New_Decl, Decl, Next : Project_Node_Id;
3033 Last, L : Project_Node_Id;
3036 if Kind_Of (Expr, Tree) /= N_Declarative_Item then
3037 New_Decl := Default_Project_Node (Tree, N_Declarative_Item);
3038 Set_Current_Item_Node (New_Decl, Tree, Expr);
3043 if Kind_Of (Parent, Tree) = N_Project then
3044 Real_Parent := Project_Declaration_Of (Parent, Tree);
3046 Real_Parent := Parent;
3049 Decl := First_Declarative_Item_Of (Real_Parent, Tree);
3051 if Decl = Empty_Node then
3052 Set_First_Declarative_Item_Of (Real_Parent, Tree, New_Decl);
3055 Next := Next_Declarative_Item (Decl, Tree);
3056 exit when Next = Empty_Node
3058 (Add_Before_First_Pkg
3059 and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
3060 N_Package_Declaration)
3062 (Add_Before_First_Case
3063 and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
3064 N_Case_Construction);
3068 -- In case Expr is in fact a range of declarative items
3072 L := Next_Declarative_Item (Last, Tree);
3073 exit when L = Empty_Node;
3077 -- In case Expr is in fact a range of declarative items
3081 L := Next_Declarative_Item (Last, Tree);
3082 exit when L = Empty_Node;
3086 Set_Next_Declarative_Item (Last, Tree, Next);
3087 Set_Next_Declarative_Item (Decl, Tree, New_Decl);
3091 ---------------------------
3092 -- Create_Literal_String --
3093 ---------------------------
3095 function Create_Literal_String
3096 (Str : Namet.Name_Id;
3097 Tree : Project_Node_Tree_Ref) return Project_Node_Id
3099 Node : Project_Node_Id;
3101 Node := Default_Project_Node (Tree, N_Literal_String, Prj.Single);
3102 Set_Next_Literal_String (Node, Tree, Empty_Node);
3103 Set_String_Value_Of (Node, Tree, Str);
3105 end Create_Literal_String;
3107 ---------------------------
3108 -- Enclose_In_Expression --
3109 ---------------------------
3111 function Enclose_In_Expression
3112 (Node : Project_Node_Id;
3113 Tree : Project_Node_Tree_Ref) return Project_Node_Id
3115 Expr : Project_Node_Id;
3117 if Kind_Of (Node, Tree) /= N_Expression then
3118 Expr := Default_Project_Node (Tree, N_Expression, Single);
3120 (Expr, Tree, Default_Project_Node (Tree, N_Term, Single));
3121 Set_Current_Term (First_Term (Expr, Tree), Tree, Node);
3126 end Enclose_In_Expression;
3128 --------------------
3129 -- Create_Package --
3130 --------------------
3132 function Create_Package
3133 (Tree : Project_Node_Tree_Ref;
3134 Project : Project_Node_Id;
3135 Pkg : String) return Project_Node_Id
3137 Pack : Project_Node_Id;
3141 Name_Len := Pkg'Length;
3142 Name_Buffer (1 .. Name_Len) := Pkg;
3145 -- Check if the package already exists
3147 Pack := First_Package_Of (Project, Tree);
3148 while Pack /= Empty_Node loop
3149 if Prj.Tree.Name_Of (Pack, Tree) = N then
3153 Pack := Next_Package_In_Project (Pack, Tree);
3156 -- Create the package and add it to the declarative item
3158 Pack := Default_Project_Node (Tree, N_Package_Declaration);
3159 Set_Name_Of (Pack, Tree, N);
3161 -- Find the correct package id to use
3163 Set_Package_Id_Of (Pack, Tree, Package_Node_Id_Of (N));
3165 -- Add it to the list of packages
3167 Set_Next_Package_In_Project
3168 (Pack, Tree, First_Package_Of (Project, Tree));
3169 Set_First_Package_Of (Project, Tree, Pack);
3171 Add_At_End (Tree, Project_Declaration_Of (Project, Tree), Pack);
3176 ----------------------
3177 -- Create_Attribute --
3178 ----------------------
3180 function Create_Attribute
3181 (Tree : Project_Node_Tree_Ref;
3182 Prj_Or_Pkg : Project_Node_Id;
3184 Index_Name : Name_Id := No_Name;
3185 Kind : Variable_Kind := List;
3186 At_Index : Integer := 0;
3187 Value : Project_Node_Id := Empty_Node) return Project_Node_Id
3189 Node : constant Project_Node_Id :=
3190 Default_Project_Node (Tree, N_Attribute_Declaration, Kind);
3192 Case_Insensitive : Boolean;
3194 Pkg : Package_Node_Id;
3195 Start_At : Attribute_Node_Id;
3196 Expr : Project_Node_Id;
3199 Set_Name_Of (Node, Tree, Name);
3201 if Index_Name /= No_Name then
3202 Set_Associative_Array_Index_Of (Node, Tree, Index_Name);
3205 if Prj_Or_Pkg /= Empty_Node then
3206 Add_At_End (Tree, Prj_Or_Pkg, Node);
3209 -- Find out the case sensitivity of the attribute
3211 if Prj_Or_Pkg /= Empty_Node
3212 and then Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration
3214 Pkg := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree));
3215 Start_At := First_Attribute_Of (Pkg);
3217 Start_At := Attribute_First;
3220 Start_At := Attribute_Node_Id_Of (Name, Start_At);
3222 Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array;
3223 Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive;
3225 if At_Index /= 0 then
3226 if Attribute_Kind_Of (Start_At) =
3227 Optional_Index_Associative_Array
3228 or else Attribute_Kind_Of (Start_At) =
3229 Optional_Index_Case_Insensitive_Associative_Array
3231 -- Results in: for Name ("index" at index) use "value";
3232 -- This is currently only used for executables.
3234 Set_Source_Index_Of (Node, Tree, To => Int (At_Index));
3237 -- Results in: for Name ("index") use "value" at index;
3239 -- ??? This limitation makes no sense, we should be able to
3240 -- set the source index on an expression.
3242 pragma Assert (Kind_Of (Value, Tree) = N_Literal_String);
3243 Set_Source_Index_Of (Value, Tree, To => Int (At_Index));
3247 if Value /= Empty_Node then
3248 Expr := Enclose_In_Expression (Value, Tree);
3249 Set_Expression_Of (Node, Tree, Expr);
3253 end Create_Attribute;