1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2016, 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
;
1154 Decl
: Project_Node_Id
;
1157 -- First check all the imported projects
1159 With_Clause
:= First_With_Clause_Of
(Project
, In_Tree
);
1160 while Present
(With_Clause
) loop
1162 -- Only non limited imported project may be used as prefix of
1163 -- variables or attributes.
1165 Result
:= Non_Limited_Project_Node_Of
(With_Clause
, In_Tree
);
1166 while Present
(Result
) loop
1167 if Name_Of
(Result
, In_Tree
) = With_Name
then
1171 Decl
:= Project_Declaration_Of
(Result
, In_Tree
);
1173 -- Do not try to check for an extended project, if the project
1174 -- does not have yet a project declaration.
1176 exit when Decl
= Empty_Node
;
1178 Result
:= Extended_Project_Of
(Decl
, In_Tree
);
1181 With_Clause
:= Next_With_Clause_Of
(With_Clause
, In_Tree
);
1184 -- If it is not an imported project, it might be an extended project
1186 if No
(With_Clause
) then
1191 (Project_Declaration_Of
(Result
, In_Tree
), In_Tree
);
1193 exit when No
(Result
)
1194 or else Name_Of
(Result
, In_Tree
) = With_Name
;
1199 end Imported_Or_Extended_Project_Of
;
1206 (Node
: Project_Node_Id
;
1207 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Kind
1210 pragma Assert
(Present
(Node
));
1211 return In_Tree
.Project_Nodes
.Table
(Node
).Kind
;
1218 function Location_Of
1219 (Node
: Project_Node_Id
;
1220 In_Tree
: Project_Node_Tree_Ref
) return Source_Ptr
1223 pragma Assert
(Present
(Node
));
1224 return In_Tree
.Project_Nodes
.Table
(Node
).Location
;
1232 (Node
: Project_Node_Id
;
1233 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
1236 pragma Assert
(Present
(Node
));
1237 return In_Tree
.Project_Nodes
.Table
(Node
).Name
;
1240 ---------------------
1241 -- Display_Name_Of --
1242 ---------------------
1244 function Display_Name_Of
1245 (Node
: Project_Node_Id
;
1246 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
1252 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1253 return In_Tree
.Project_Nodes
.Table
(Node
).Display_Name
;
1254 end Display_Name_Of
;
1256 --------------------
1257 -- Next_Case_Item --
1258 --------------------
1260 function Next_Case_Item
1261 (Node
: Project_Node_Id
;
1262 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1268 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
1269 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1276 function Next_Comment
1277 (Node
: Project_Node_Id
;
1278 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1284 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
1285 return In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
1288 ---------------------------
1289 -- Next_Declarative_Item --
1290 ---------------------------
1292 function Next_Declarative_Item
1293 (Node
: Project_Node_Id
;
1294 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1300 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
1301 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1302 end Next_Declarative_Item
;
1304 -----------------------------
1305 -- Next_Expression_In_List --
1306 -----------------------------
1308 function Next_Expression_In_List
1309 (Node
: Project_Node_Id
;
1310 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1316 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
1317 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1318 end Next_Expression_In_List
;
1320 -------------------------
1321 -- Next_Literal_String --
1322 -------------------------
1324 function Next_Literal_String
1325 (Node
: Project_Node_Id
;
1326 In_Tree
: Project_Node_Tree_Ref
)
1327 return Project_Node_Id
1333 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
);
1334 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
1335 end Next_Literal_String
;
1337 -----------------------------
1338 -- Next_Package_In_Project --
1339 -----------------------------
1341 function Next_Package_In_Project
1342 (Node
: Project_Node_Id
;
1343 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1349 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1350 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1351 end Next_Package_In_Project
;
1353 ----------------------
1354 -- Next_String_Type --
1355 ----------------------
1357 function Next_String_Type
1358 (Node
: Project_Node_Id
;
1359 In_Tree
: Project_Node_Tree_Ref
)
1360 return Project_Node_Id
1366 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1367 N_String_Type_Declaration
);
1368 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1369 end Next_String_Type
;
1376 (Node
: Project_Node_Id
;
1377 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1382 and then In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
);
1383 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1390 function Next_Variable
1391 (Node
: Project_Node_Id
;
1392 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1398 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1399 N_Typed_Variable_Declaration
1401 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1402 N_Variable_Declaration
));
1404 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1407 -------------------------
1408 -- Next_With_Clause_Of --
1409 -------------------------
1411 function Next_With_Clause_Of
1412 (Node
: Project_Node_Id
;
1413 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1419 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
1420 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1421 end Next_With_Clause_Of
;
1427 function No
(Node
: Project_Node_Id
) return Boolean is
1429 return Node
= Empty_Node
;
1432 ---------------------------------
1433 -- Non_Limited_Project_Node_Of --
1434 ---------------------------------
1436 function Non_Limited_Project_Node_Of
1437 (Node
: Project_Node_Id
;
1438 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1444 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1445 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1446 end Non_Limited_Project_Node_Of
;
1452 function Package_Id_Of
1453 (Node
: Project_Node_Id
;
1454 In_Tree
: Project_Node_Tree_Ref
) return Package_Node_Id
1460 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1461 return In_Tree
.Project_Nodes
.Table
(Node
).Pkg_Id
;
1464 ---------------------
1465 -- Package_Node_Of --
1466 ---------------------
1468 function Package_Node_Of
1469 (Node
: Project_Node_Id
;
1470 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1476 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1478 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1479 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1480 end Package_Node_Of
;
1486 function Path_Name_Of
1487 (Node
: Project_Node_Id
;
1488 In_Tree
: Project_Node_Tree_Ref
) return Path_Name_Type
1494 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
1496 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1497 return In_Tree
.Project_Nodes
.Table
(Node
).Path_Name
;
1504 function Present
(Node
: Project_Node_Id
) return Boolean is
1506 return Node
/= Empty_Node
;
1509 ----------------------------
1510 -- Project_Declaration_Of --
1511 ----------------------------
1513 function Project_Declaration_Of
1514 (Node
: Project_Node_Id
;
1515 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1521 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1522 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1523 end Project_Declaration_Of
;
1525 --------------------------
1526 -- Project_Qualifier_Of --
1527 --------------------------
1529 function Project_Qualifier_Of
1530 (Node
: Project_Node_Id
;
1531 In_Tree
: Project_Node_Tree_Ref
) return Project_Qualifier
1537 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1538 return In_Tree
.Project_Nodes
.Table
(Node
).Qualifier
;
1539 end Project_Qualifier_Of
;
1541 -----------------------
1542 -- Parent_Project_Of --
1543 -----------------------
1545 function Parent_Project_Of
1546 (Node
: Project_Node_Id
;
1547 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1553 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1554 return In_Tree
.Project_Nodes
.Table
(Node
).Field4
;
1555 end Parent_Project_Of
;
1557 -------------------------------------------
1558 -- Project_File_Includes_Unkept_Comments --
1559 -------------------------------------------
1561 function Project_File_Includes_Unkept_Comments
1562 (Node
: Project_Node_Id
;
1563 In_Tree
: Project_Node_Tree_Ref
) return Boolean
1565 Declaration
: constant Project_Node_Id
:=
1566 Project_Declaration_Of
(Node
, In_Tree
);
1568 return In_Tree
.Project_Nodes
.Table
(Declaration
).Flag1
;
1569 end Project_File_Includes_Unkept_Comments
;
1571 ---------------------
1572 -- Project_Node_Of --
1573 ---------------------
1575 function Project_Node_Of
1576 (Node
: Project_Node_Id
;
1577 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1583 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
1585 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1587 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1588 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
1589 end Project_Node_Of
;
1591 -----------------------------------
1592 -- Project_Of_Renamed_Package_Of --
1593 -----------------------------------
1595 function Project_Of_Renamed_Package_Of
1596 (Node
: Project_Node_Id
;
1597 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1603 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1604 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
1605 end Project_Of_Renamed_Package_Of
;
1607 --------------------------
1608 -- Remove_Next_End_Node --
1609 --------------------------
1611 procedure Remove_Next_End_Node
is
1613 Next_End_Nodes
.Decrement_Last
;
1614 end Remove_Next_End_Node
;
1620 procedure Reset_State
is
1622 End_Of_Line_Node
:= Empty_Node
;
1623 Previous_Line_Node
:= Empty_Node
;
1624 Previous_End_Node
:= Empty_Node
;
1625 Unkept_Comments
:= False;
1626 Comments
.Set_Last
(0);
1629 ----------------------
1630 -- Restore_And_Free --
1631 ----------------------
1633 procedure Restore_And_Free
(S
: in out Comment_State
) is
1634 procedure Unchecked_Free
is new
1635 Ada
.Unchecked_Deallocation
(Comment_Array
, Comments_Ptr
);
1638 End_Of_Line_Node
:= S
.End_Of_Line_Node
;
1639 Previous_Line_Node
:= S
.Previous_Line_Node
;
1640 Previous_End_Node
:= S
.Previous_End_Node
;
1641 Next_End_Nodes
.Set_Last
(0);
1642 Unkept_Comments
:= S
.Unkept_Comments
;
1644 Comments
.Set_Last
(0);
1646 for J
in S
.Comments
'Range loop
1647 Comments
.Increment_Last
;
1648 Comments
.Table
(Comments
.Last
) := S
.Comments
(J
);
1651 Unchecked_Free
(S
.Comments
);
1652 end Restore_And_Free
;
1658 procedure Save
(S
: out Comment_State
) is
1659 Cmts
: constant Comments_Ptr
:= new Comment_Array
(1 .. Comments
.Last
);
1662 for J
in 1 .. Comments
.Last
loop
1663 Cmts
(J
) := Comments
.Table
(J
);
1667 (End_Of_Line_Node
=> End_Of_Line_Node
,
1668 Previous_Line_Node
=> Previous_Line_Node
,
1669 Previous_End_Node
=> Previous_End_Node
,
1670 Unkept_Comments
=> Unkept_Comments
,
1678 procedure Scan
(In_Tree
: Project_Node_Tree_Ref
) is
1679 Empty_Line
: Boolean := False;
1682 -- If there are comments, then they will not be kept. Set the flag and
1683 -- clear the comments.
1685 if Comments
.Last
> 0 then
1686 Unkept_Comments
:= True;
1687 Comments
.Set_Last
(0);
1690 -- Loop until a token other that End_Of_Line or Comment is found
1693 Prj
.Err
.Scanner
.Scan
;
1696 when Tok_End_Of_Line
=>
1697 if Prev_Token
= Tok_End_Of_Line
then
1700 if Comments
.Last
> 0 then
1701 Comments
.Table
(Comments
.Last
).Is_Followed_By_Empty_Line
1707 -- If this is a line comment, add it to the comment table
1709 if Prev_Token
= Tok_End_Of_Line
1710 or else Prev_Token
= No_Token
1712 Comments
.Increment_Last
;
1713 Comments
.Table
(Comments
.Last
) :=
1714 (Value
=> Comment_Id
,
1715 Follows_Empty_Line
=> Empty_Line
,
1716 Is_Followed_By_Empty_Line
=> False);
1718 -- Otherwise, it is an end of line comment. If there is an
1719 -- end of line node specified, associate the comment with
1722 elsif Present
(End_Of_Line_Node
) then
1724 Zones
: constant Project_Node_Id
:=
1725 Comment_Zones_Of
(End_Of_Line_Node
, In_Tree
);
1727 In_Tree
.Project_Nodes
.Table
(Zones
).Value
:= Comment_Id
;
1730 -- Otherwise, this end of line node cannot be kept
1733 Unkept_Comments
:= True;
1734 Comments
.Set_Last
(0);
1737 Empty_Line
:= False;
1741 -- If there are comments, where the first comment is not
1742 -- following an empty line, put the initial uninterrupted
1743 -- comment zone with the node of the preceding line (either
1744 -- a Previous_Line or a Previous_End node), if any.
1746 if Comments
.Last
> 0
1747 and then not Comments
.Table
(1).Follows_Empty_Line
1749 if Present
(Previous_Line_Node
) then
1751 (To
=> Previous_Line_Node
,
1753 In_Tree
=> In_Tree
);
1755 elsif Present
(Previous_End_Node
) then
1757 (To
=> Previous_End_Node
,
1759 In_Tree
=> In_Tree
);
1763 -- If there are still comments and the token is "end", then
1764 -- put these comments with the Next_End node, if any;
1765 -- otherwise, these comments cannot be kept. Always clear
1768 if Comments
.Last
> 0 and then Token
= Tok_End
then
1769 if Next_End_Nodes
.Last
> 0 then
1771 (To
=> Next_End_Nodes
.Table
(Next_End_Nodes
.Last
),
1772 Where
=> Before_End
,
1773 In_Tree
=> In_Tree
);
1776 Unkept_Comments
:= True;
1779 Comments
.Set_Last
(0);
1782 -- Reset the End_Of_Line, Previous_Line and Previous_End nodes
1783 -- so that they are not used again.
1785 End_Of_Line_Node
:= Empty_Node
;
1786 Previous_Line_Node
:= Empty_Node
;
1787 Previous_End_Node
:= Empty_Node
;
1796 ------------------------------------
1797 -- Set_Associative_Array_Index_Of --
1798 ------------------------------------
1800 procedure Set_Associative_Array_Index_Of
1801 (Node
: Project_Node_Id
;
1802 In_Tree
: Project_Node_Tree_Ref
;
1809 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1811 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1812 In_Tree
.Project_Nodes
.Table
(Node
).Value
:= To
;
1813 end Set_Associative_Array_Index_Of
;
1815 --------------------------------
1816 -- Set_Associative_Package_Of --
1817 --------------------------------
1819 procedure Set_Associative_Package_Of
1820 (Node
: Project_Node_Id
;
1821 In_Tree
: Project_Node_Tree_Ref
;
1822 To
: Project_Node_Id
)
1828 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
);
1829 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
1830 end Set_Associative_Package_Of
;
1832 --------------------------------
1833 -- Set_Associative_Project_Of --
1834 --------------------------------
1836 procedure Set_Associative_Project_Of
1837 (Node
: Project_Node_Id
;
1838 In_Tree
: Project_Node_Tree_Ref
;
1839 To
: Project_Node_Id
)
1845 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1846 N_Attribute_Declaration
));
1847 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
1848 end Set_Associative_Project_Of
;
1850 --------------------------
1851 -- Set_Case_Insensitive --
1852 --------------------------
1854 procedure Set_Case_Insensitive
1855 (Node
: Project_Node_Id
;
1856 In_Tree
: Project_Node_Tree_Ref
;
1863 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1865 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1866 In_Tree
.Project_Nodes
.Table
(Node
).Flag1
:= To
;
1867 end Set_Case_Insensitive
;
1869 ------------------------------------
1870 -- Set_Case_Variable_Reference_Of --
1871 ------------------------------------
1873 procedure Set_Case_Variable_Reference_Of
1874 (Node
: Project_Node_Id
;
1875 In_Tree
: Project_Node_Tree_Ref
;
1876 To
: Project_Node_Id
)
1882 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
1883 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1884 end Set_Case_Variable_Reference_Of
;
1886 ---------------------------
1887 -- Set_Current_Item_Node --
1888 ---------------------------
1890 procedure Set_Current_Item_Node
1891 (Node
: Project_Node_Id
;
1892 In_Tree
: Project_Node_Tree_Ref
;
1893 To
: Project_Node_Id
)
1899 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
1900 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1901 end Set_Current_Item_Node
;
1903 ----------------------
1904 -- Set_Current_Term --
1905 ----------------------
1907 procedure Set_Current_Term
1908 (Node
: Project_Node_Id
;
1909 In_Tree
: Project_Node_Tree_Ref
;
1910 To
: Project_Node_Id
)
1916 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
);
1917 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1918 end Set_Current_Term
;
1920 --------------------
1921 -- Set_Default_Of --
1922 --------------------
1924 procedure Set_Default_Of
1925 (Node
: Project_Node_Id
;
1926 In_Tree
: Project_Node_Tree_Ref
;
1927 To
: Attribute_Default_Value
)
1933 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
);
1934 In_Tree
.Project_Nodes
.Table
(Node
).Default
:= To
;
1937 ----------------------
1938 -- Set_Directory_Of --
1939 ----------------------
1941 procedure Set_Directory_Of
1942 (Node
: Project_Node_Id
;
1943 In_Tree
: Project_Node_Tree_Ref
;
1944 To
: Path_Name_Type
)
1950 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1951 In_Tree
.Project_Nodes
.Table
(Node
).Directory
:= To
;
1952 end Set_Directory_Of
;
1954 ---------------------
1955 -- Set_End_Of_Line --
1956 ---------------------
1958 procedure Set_End_Of_Line
(To
: Project_Node_Id
) is
1960 End_Of_Line_Node
:= To
;
1961 end Set_End_Of_Line
;
1963 ----------------------------
1964 -- Set_Expression_Kind_Of --
1965 ----------------------------
1967 procedure Set_Expression_Kind_Of
1968 (Node
: Project_Node_Id
;
1969 In_Tree
: Project_Node_Tree_Ref
;
1975 and then -- should use Nkind_In here ??? why not???
1976 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
1978 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1980 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
1982 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1983 N_Typed_Variable_Declaration
1985 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
1987 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
1989 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
1991 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1993 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
1995 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
));
1996 In_Tree
.Project_Nodes
.Table
(Node
).Expr_Kind
:= To
;
1997 end Set_Expression_Kind_Of
;
1999 -----------------------
2000 -- Set_Expression_Of --
2001 -----------------------
2003 procedure Set_Expression_Of
2004 (Node
: Project_Node_Id
;
2005 In_Tree
: Project_Node_Tree_Ref
;
2006 To
: Project_Node_Id
)
2012 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2013 N_Attribute_Declaration
2015 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2016 N_Typed_Variable_Declaration
2018 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2019 N_Variable_Declaration
));
2020 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2021 end Set_Expression_Of
;
2023 -------------------------------
2024 -- Set_External_Reference_Of --
2025 -------------------------------
2027 procedure Set_External_Reference_Of
2028 (Node
: Project_Node_Id
;
2029 In_Tree
: Project_Node_Tree_Ref
;
2030 To
: Project_Node_Id
)
2036 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
2037 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2038 end Set_External_Reference_Of
;
2040 -----------------------------
2041 -- Set_External_Default_Of --
2042 -----------------------------
2044 procedure Set_External_Default_Of
2045 (Node
: Project_Node_Id
;
2046 In_Tree
: Project_Node_Tree_Ref
;
2047 To
: Project_Node_Id
)
2053 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
2054 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2055 end Set_External_Default_Of
;
2057 ----------------------------
2058 -- Set_First_Case_Item_Of --
2059 ----------------------------
2061 procedure Set_First_Case_Item_Of
2062 (Node
: Project_Node_Id
;
2063 In_Tree
: Project_Node_Tree_Ref
;
2064 To
: Project_Node_Id
)
2070 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
2071 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2072 end Set_First_Case_Item_Of
;
2074 -------------------------
2075 -- Set_First_Choice_Of --
2076 -------------------------
2078 procedure Set_First_Choice_Of
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_Case_Item
);
2088 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2089 end Set_First_Choice_Of
;
2091 -----------------------------
2092 -- Set_First_Comment_After --
2093 -----------------------------
2095 procedure Set_First_Comment_After
2096 (Node
: Project_Node_Id
;
2097 In_Tree
: Project_Node_Tree_Ref
;
2098 To
: Project_Node_Id
)
2100 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
2102 In_Tree
.Project_Nodes
.Table
(Zone
).Field2
:= To
;
2103 end Set_First_Comment_After
;
2105 ---------------------------------
2106 -- Set_First_Comment_After_End --
2107 ---------------------------------
2109 procedure Set_First_Comment_After_End
2110 (Node
: Project_Node_Id
;
2111 In_Tree
: Project_Node_Tree_Ref
;
2112 To
: Project_Node_Id
)
2114 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
2116 In_Tree
.Project_Nodes
.Table
(Zone
).Comments
:= To
;
2117 end Set_First_Comment_After_End
;
2119 ------------------------------
2120 -- Set_First_Comment_Before --
2121 ------------------------------
2123 procedure Set_First_Comment_Before
2124 (Node
: Project_Node_Id
;
2125 In_Tree
: Project_Node_Tree_Ref
;
2126 To
: Project_Node_Id
)
2128 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
2130 In_Tree
.Project_Nodes
.Table
(Zone
).Field1
:= To
;
2131 end Set_First_Comment_Before
;
2133 ----------------------------------
2134 -- Set_First_Comment_Before_End --
2135 ----------------------------------
2137 procedure Set_First_Comment_Before_End
2138 (Node
: Project_Node_Id
;
2139 In_Tree
: Project_Node_Tree_Ref
;
2140 To
: Project_Node_Id
)
2142 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
2144 In_Tree
.Project_Nodes
.Table
(Zone
).Field2
:= To
;
2145 end Set_First_Comment_Before_End
;
2147 ------------------------
2148 -- Set_Next_Case_Item --
2149 ------------------------
2151 procedure Set_Next_Case_Item
2152 (Node
: Project_Node_Id
;
2153 In_Tree
: Project_Node_Tree_Ref
;
2154 To
: Project_Node_Id
)
2160 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
2161 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2162 end Set_Next_Case_Item
;
2164 ----------------------
2165 -- Set_Next_Comment --
2166 ----------------------
2168 procedure Set_Next_Comment
2169 (Node
: Project_Node_Id
;
2170 In_Tree
: Project_Node_Tree_Ref
;
2171 To
: Project_Node_Id
)
2177 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
2178 In_Tree
.Project_Nodes
.Table
(Node
).Comments
:= To
;
2179 end Set_Next_Comment
;
2181 -----------------------------------
2182 -- Set_First_Declarative_Item_Of --
2183 -----------------------------------
2185 procedure Set_First_Declarative_Item_Of
2186 (Node
: Project_Node_Id
;
2187 In_Tree
: Project_Node_Tree_Ref
;
2188 To
: Project_Node_Id
)
2194 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
2196 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
2198 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
2200 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
then
2201 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2203 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2205 end Set_First_Declarative_Item_Of
;
2207 ----------------------------------
2208 -- Set_First_Expression_In_List --
2209 ----------------------------------
2211 procedure Set_First_Expression_In_List
2212 (Node
: Project_Node_Id
;
2213 In_Tree
: Project_Node_Tree_Ref
;
2214 To
: Project_Node_Id
)
2220 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String_List
);
2221 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2222 end Set_First_Expression_In_List
;
2224 ------------------------------
2225 -- Set_First_Literal_String --
2226 ------------------------------
2228 procedure Set_First_Literal_String
2229 (Node
: Project_Node_Id
;
2230 In_Tree
: Project_Node_Tree_Ref
;
2231 To
: Project_Node_Id
)
2237 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2238 N_String_Type_Declaration
);
2239 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2240 end Set_First_Literal_String
;
2242 --------------------------
2243 -- Set_First_Package_Of --
2244 --------------------------
2246 procedure Set_First_Package_Of
2247 (Node
: Project_Node_Id
;
2248 In_Tree
: Project_Node_Tree_Ref
;
2249 To
: Package_Declaration_Id
)
2255 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2256 In_Tree
.Project_Nodes
.Table
(Node
).Packages
:= To
;
2257 end Set_First_Package_Of
;
2259 ------------------------------
2260 -- Set_First_String_Type_Of --
2261 ------------------------------
2263 procedure Set_First_String_Type_Of
2264 (Node
: Project_Node_Id
;
2265 In_Tree
: Project_Node_Tree_Ref
;
2266 To
: Project_Node_Id
)
2272 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2273 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2274 end Set_First_String_Type_Of
;
2276 --------------------
2277 -- Set_First_Term --
2278 --------------------
2280 procedure Set_First_Term
2281 (Node
: Project_Node_Id
;
2282 In_Tree
: Project_Node_Tree_Ref
;
2283 To
: Project_Node_Id
)
2289 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
2290 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2293 ---------------------------
2294 -- Set_First_Variable_Of --
2295 ---------------------------
2297 procedure Set_First_Variable_Of
2298 (Node
: Project_Node_Id
;
2299 In_Tree
: Project_Node_Tree_Ref
;
2300 To
: Variable_Node_Id
)
2306 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
2308 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
2309 In_Tree
.Project_Nodes
.Table
(Node
).Variables
:= To
;
2310 end Set_First_Variable_Of
;
2312 ------------------------------
2313 -- Set_First_With_Clause_Of --
2314 ------------------------------
2316 procedure Set_First_With_Clause_Of
2317 (Node
: Project_Node_Id
;
2318 In_Tree
: Project_Node_Tree_Ref
;
2319 To
: Project_Node_Id
)
2325 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2326 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2327 end Set_First_With_Clause_Of
;
2329 --------------------------
2330 -- Set_Is_Extending_All --
2331 --------------------------
2333 procedure Set_Is_Extending_All
2334 (Node
: Project_Node_Id
;
2335 In_Tree
: Project_Node_Tree_Ref
)
2341 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
2343 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
2344 In_Tree
.Project_Nodes
.Table
(Node
).Flag2
:= True;
2345 end Set_Is_Extending_All
;
2347 -----------------------------
2348 -- Set_Is_Not_Last_In_List --
2349 -----------------------------
2351 procedure Set_Is_Not_Last_In_List
2352 (Node
: Project_Node_Id
;
2353 In_Tree
: Project_Node_Tree_Ref
)
2358 and then In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
2359 In_Tree
.Project_Nodes
.Table
(Node
).Flag1
:= True;
2360 end Set_Is_Not_Last_In_List
;
2366 procedure Set_Kind_Of
2367 (Node
: Project_Node_Id
;
2368 In_Tree
: Project_Node_Tree_Ref
;
2369 To
: Project_Node_Kind
)
2372 pragma Assert
(Present
(Node
));
2373 In_Tree
.Project_Nodes
.Table
(Node
).Kind
:= To
;
2376 ---------------------
2377 -- Set_Location_Of --
2378 ---------------------
2380 procedure Set_Location_Of
2381 (Node
: Project_Node_Id
;
2382 In_Tree
: Project_Node_Tree_Ref
;
2386 pragma Assert
(Present
(Node
));
2387 In_Tree
.Project_Nodes
.Table
(Node
).Location
:= To
;
2388 end Set_Location_Of
;
2390 -----------------------------
2391 -- Set_Extended_Project_Of --
2392 -----------------------------
2394 procedure Set_Extended_Project_Of
2395 (Node
: Project_Node_Id
;
2396 In_Tree
: Project_Node_Tree_Ref
;
2397 To
: Project_Node_Id
)
2403 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
2404 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2405 end Set_Extended_Project_Of
;
2407 ----------------------------------
2408 -- Set_Extended_Project_Path_Of --
2409 ----------------------------------
2411 procedure Set_Extended_Project_Path_Of
2412 (Node
: Project_Node_Id
;
2413 In_Tree
: Project_Node_Tree_Ref
;
2414 To
: Path_Name_Type
)
2420 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2421 In_Tree
.Project_Nodes
.Table
(Node
).Value
:= Name_Id
(To
);
2422 end Set_Extended_Project_Path_Of
;
2424 ------------------------------
2425 -- Set_Extending_Project_Of --
2426 ------------------------------
2428 procedure Set_Extending_Project_Of
2429 (Node
: Project_Node_Id
;
2430 In_Tree
: Project_Node_Tree_Ref
;
2431 To
: Project_Node_Id
)
2437 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
2438 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2439 end Set_Extending_Project_Of
;
2445 procedure Set_Name_Of
2446 (Node
: Project_Node_Id
;
2447 In_Tree
: Project_Node_Tree_Ref
;
2451 pragma Assert
(Present
(Node
));
2452 In_Tree
.Project_Nodes
.Table
(Node
).Name
:= To
;
2455 -------------------------
2456 -- Set_Display_Name_Of --
2457 -------------------------
2459 procedure Set_Display_Name_Of
2460 (Node
: Project_Node_Id
;
2461 In_Tree
: Project_Node_Tree_Ref
;
2467 and then In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2468 In_Tree
.Project_Nodes
.Table
(Node
).Display_Name
:= To
;
2469 end Set_Display_Name_Of
;
2471 -------------------------------
2472 -- Set_Next_Declarative_Item --
2473 -------------------------------
2475 procedure Set_Next_Declarative_Item
2476 (Node
: Project_Node_Id
;
2477 In_Tree
: Project_Node_Tree_Ref
;
2478 To
: Project_Node_Id
)
2484 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
2485 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2486 end Set_Next_Declarative_Item
;
2488 -----------------------
2489 -- Set_Next_End_Node --
2490 -----------------------
2492 procedure Set_Next_End_Node
(To
: Project_Node_Id
) is
2494 Next_End_Nodes
.Increment_Last
;
2495 Next_End_Nodes
.Table
(Next_End_Nodes
.Last
) := To
;
2496 end Set_Next_End_Node
;
2498 ---------------------------------
2499 -- Set_Next_Expression_In_List --
2500 ---------------------------------
2502 procedure Set_Next_Expression_In_List
2503 (Node
: Project_Node_Id
;
2504 In_Tree
: Project_Node_Tree_Ref
;
2505 To
: Project_Node_Id
)
2511 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
2512 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2513 end Set_Next_Expression_In_List
;
2515 -----------------------------
2516 -- Set_Next_Literal_String --
2517 -----------------------------
2519 procedure Set_Next_Literal_String
2520 (Node
: Project_Node_Id
;
2521 In_Tree
: Project_Node_Tree_Ref
;
2522 To
: Project_Node_Id
)
2528 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
);
2529 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2530 end Set_Next_Literal_String
;
2532 ---------------------------------
2533 -- Set_Next_Package_In_Project --
2534 ---------------------------------
2536 procedure Set_Next_Package_In_Project
2537 (Node
: Project_Node_Id
;
2538 In_Tree
: Project_Node_Tree_Ref
;
2539 To
: Project_Node_Id
)
2545 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2546 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2547 end Set_Next_Package_In_Project
;
2549 --------------------------
2550 -- Set_Next_String_Type --
2551 --------------------------
2553 procedure Set_Next_String_Type
2554 (Node
: Project_Node_Id
;
2555 In_Tree
: Project_Node_Tree_Ref
;
2556 To
: Project_Node_Id
)
2562 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2563 N_String_Type_Declaration
);
2564 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2565 end Set_Next_String_Type
;
2571 procedure Set_Next_Term
2572 (Node
: Project_Node_Id
;
2573 In_Tree
: Project_Node_Tree_Ref
;
2574 To
: Project_Node_Id
)
2580 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
);
2581 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2584 -----------------------
2585 -- Set_Next_Variable --
2586 -----------------------
2588 procedure Set_Next_Variable
2589 (Node
: Project_Node_Id
;
2590 In_Tree
: Project_Node_Tree_Ref
;
2591 To
: Project_Node_Id
)
2597 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2598 N_Typed_Variable_Declaration
2600 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2601 N_Variable_Declaration
));
2602 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2603 end Set_Next_Variable
;
2605 -----------------------------
2606 -- Set_Next_With_Clause_Of --
2607 -----------------------------
2609 procedure Set_Next_With_Clause_Of
2610 (Node
: Project_Node_Id
;
2611 In_Tree
: Project_Node_Tree_Ref
;
2612 To
: Project_Node_Id
)
2618 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
2619 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2620 end Set_Next_With_Clause_Of
;
2622 -----------------------
2623 -- Set_Package_Id_Of --
2624 -----------------------
2626 procedure Set_Package_Id_Of
2627 (Node
: Project_Node_Id
;
2628 In_Tree
: Project_Node_Tree_Ref
;
2629 To
: Package_Node_Id
)
2635 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2636 In_Tree
.Project_Nodes
.Table
(Node
).Pkg_Id
:= To
;
2637 end Set_Package_Id_Of
;
2639 -------------------------
2640 -- Set_Package_Node_Of --
2641 -------------------------
2643 procedure Set_Package_Node_Of
2644 (Node
: Project_Node_Id
;
2645 In_Tree
: Project_Node_Tree_Ref
;
2646 To
: Project_Node_Id
)
2652 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2654 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
2655 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2656 end Set_Package_Node_Of
;
2658 ----------------------
2659 -- Set_Path_Name_Of --
2660 ----------------------
2662 procedure Set_Path_Name_Of
2663 (Node
: Project_Node_Id
;
2664 In_Tree
: Project_Node_Tree_Ref
;
2665 To
: Path_Name_Type
)
2671 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
2673 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
2674 In_Tree
.Project_Nodes
.Table
(Node
).Path_Name
:= To
;
2675 end Set_Path_Name_Of
;
2677 ---------------------------
2678 -- Set_Previous_End_Node --
2679 ---------------------------
2680 procedure Set_Previous_End_Node
(To
: Project_Node_Id
) is
2682 Previous_End_Node
:= To
;
2683 end Set_Previous_End_Node
;
2685 ----------------------------
2686 -- Set_Previous_Line_Node --
2687 ----------------------------
2689 procedure Set_Previous_Line_Node
(To
: Project_Node_Id
) is
2691 Previous_Line_Node
:= To
;
2692 end Set_Previous_Line_Node
;
2694 --------------------------------
2695 -- Set_Project_Declaration_Of --
2696 --------------------------------
2698 procedure Set_Project_Declaration_Of
2699 (Node
: Project_Node_Id
;
2700 In_Tree
: Project_Node_Tree_Ref
;
2701 To
: Project_Node_Id
)
2707 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2708 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2709 end Set_Project_Declaration_Of
;
2711 ------------------------------
2712 -- Set_Project_Qualifier_Of --
2713 ------------------------------
2715 procedure Set_Project_Qualifier_Of
2716 (Node
: Project_Node_Id
;
2717 In_Tree
: Project_Node_Tree_Ref
;
2718 To
: Project_Qualifier
)
2723 and then In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2724 In_Tree
.Project_Nodes
.Table
(Node
).Qualifier
:= To
;
2725 end Set_Project_Qualifier_Of
;
2727 ---------------------------
2728 -- Set_Parent_Project_Of --
2729 ---------------------------
2731 procedure Set_Parent_Project_Of
2732 (Node
: Project_Node_Id
;
2733 In_Tree
: Project_Node_Tree_Ref
;
2734 To
: Project_Node_Id
)
2739 and then In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2740 In_Tree
.Project_Nodes
.Table
(Node
).Field4
:= To
;
2741 end Set_Parent_Project_Of
;
2743 -----------------------------------------------
2744 -- Set_Project_File_Includes_Unkept_Comments --
2745 -----------------------------------------------
2747 procedure Set_Project_File_Includes_Unkept_Comments
2748 (Node
: Project_Node_Id
;
2749 In_Tree
: Project_Node_Tree_Ref
;
2752 Declaration
: constant Project_Node_Id
:=
2753 Project_Declaration_Of
(Node
, In_Tree
);
2755 In_Tree
.Project_Nodes
.Table
(Declaration
).Flag1
:= To
;
2756 end Set_Project_File_Includes_Unkept_Comments
;
2758 -------------------------
2759 -- Set_Project_Node_Of --
2760 -------------------------
2762 procedure Set_Project_Node_Of
2763 (Node
: Project_Node_Id
;
2764 In_Tree
: Project_Node_Tree_Ref
;
2765 To
: Project_Node_Id
;
2766 Limited_With
: Boolean := False)
2772 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2774 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2776 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
2777 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2779 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2780 and then not Limited_With
2782 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2784 end Set_Project_Node_Of
;
2786 ---------------------------------------
2787 -- Set_Project_Of_Renamed_Package_Of --
2788 ---------------------------------------
2790 procedure Set_Project_Of_Renamed_Package_Of
2791 (Node
: Project_Node_Id
;
2792 In_Tree
: Project_Node_Tree_Ref
;
2793 To
: Project_Node_Id
)
2799 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2800 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2801 end Set_Project_Of_Renamed_Package_Of
;
2803 -------------------------
2804 -- Set_Source_Index_Of --
2805 -------------------------
2807 procedure Set_Source_Index_Of
2808 (Node
: Project_Node_Id
;
2809 In_Tree
: Project_Node_Tree_Ref
;
2816 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
2818 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2819 N_Attribute_Declaration
));
2820 In_Tree
.Project_Nodes
.Table
(Node
).Src_Index
:= To
;
2821 end Set_Source_Index_Of
;
2823 ------------------------
2824 -- Set_String_Type_Of --
2825 ------------------------
2827 procedure Set_String_Type_Of
2828 (Node
: Project_Node_Id
;
2829 In_Tree
: Project_Node_Tree_Ref
;
2830 To
: Project_Node_Id
)
2836 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2837 N_Variable_Reference
2839 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2840 N_Typed_Variable_Declaration
)
2842 In_Tree
.Project_Nodes
.Table
(To
).Kind
= N_String_Type_Declaration
);
2844 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
then
2845 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2847 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2849 end Set_String_Type_Of
;
2851 -------------------------
2852 -- Set_String_Value_Of --
2853 -------------------------
2855 procedure Set_String_Value_Of
2856 (Node
: Project_Node_Id
;
2857 In_Tree
: Project_Node_Tree_Ref
;
2864 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2866 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
2868 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
));
2869 In_Tree
.Project_Nodes
.Table
(Node
).Value
:= To
;
2870 end Set_String_Value_Of
;
2872 ---------------------
2873 -- Source_Index_Of --
2874 ---------------------
2876 function Source_Index_Of
2877 (Node
: Project_Node_Id
;
2878 In_Tree
: Project_Node_Tree_Ref
) return Int
2884 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
2886 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2887 N_Attribute_Declaration
));
2888 return In_Tree
.Project_Nodes
.Table
(Node
).Src_Index
;
2889 end Source_Index_Of
;
2891 --------------------
2892 -- String_Type_Of --
2893 --------------------
2895 function String_Type_Of
2896 (Node
: Project_Node_Id
;
2897 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
2903 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2904 N_Variable_Reference
2906 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2907 N_Typed_Variable_Declaration
));
2909 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
then
2910 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
2912 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
2916 ---------------------
2917 -- String_Value_Of --
2918 ---------------------
2920 function String_Value_Of
2921 (Node
: Project_Node_Id
;
2922 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
2928 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2930 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
2932 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
));
2933 return In_Tree
.Project_Nodes
.Table
(Node
).Value
;
2934 end String_Value_Of
;
2936 --------------------
2937 -- Value_Is_Valid --
2938 --------------------
2940 function Value_Is_Valid
2941 (For_Typed_Variable
: Project_Node_Id
;
2942 In_Tree
: Project_Node_Tree_Ref
;
2943 Value
: Name_Id
) return Boolean
2947 (Present
(For_Typed_Variable
)
2949 (In_Tree
.Project_Nodes
.Table
(For_Typed_Variable
).Kind
=
2950 N_Typed_Variable_Declaration
));
2953 Current_String
: Project_Node_Id
:=
2954 First_Literal_String
2955 (String_Type_Of
(For_Typed_Variable
, In_Tree
),
2959 while Present
(Current_String
)
2961 String_Value_Of
(Current_String
, In_Tree
) /= Value
2964 Next_Literal_String
(Current_String
, In_Tree
);
2967 return Present
(Current_String
);
2972 -------------------------------
2973 -- There_Are_Unkept_Comments --
2974 -------------------------------
2976 function There_Are_Unkept_Comments
return Boolean is
2978 return Unkept_Comments
;
2979 end There_Are_Unkept_Comments
;
2981 --------------------
2982 -- Create_Project --
2983 --------------------
2985 function Create_Project
2986 (In_Tree
: Project_Node_Tree_Ref
;
2988 Full_Path
: Path_Name_Type
;
2989 Is_Config_File
: Boolean := False) return Project_Node_Id
2991 Project
: Project_Node_Id
;
2992 Qualifier
: Project_Qualifier
:= Unspecified
;
2994 Project
:= Default_Project_Node
(In_Tree
, N_Project
);
2995 Set_Name_Of
(Project
, In_Tree
, Name
);
2996 Set_Display_Name_Of
(Project
, In_Tree
, Name
);
2999 Path_Name_Type
(Get_Directory
(File_Name_Type
(Full_Path
))));
3000 Set_Path_Name_Of
(Project
, In_Tree
, Full_Path
);
3002 Set_Project_Declaration_Of
3004 Default_Project_Node
(In_Tree
, N_Project_Declaration
));
3006 if Is_Config_File
then
3007 Qualifier
:= Configuration
;
3010 if not Is_Config_File
then
3011 Prj
.Tree
.Tree_Private_Part
.Projects_Htable
.Set
3012 (In_Tree
.Projects_HT
,
3014 Prj
.Tree
.Tree_Private_Part
.Project_Name_And_Node
'
3016 Resolved_Path => No_Path,
3019 From_Extended => False,
3020 Proj_Qualifier => Qualifier));
3030 procedure Add_At_End
3031 (Tree : Project_Node_Tree_Ref;
3032 Parent : Project_Node_Id;
3033 Expr : Project_Node_Id;
3034 Add_Before_First_Pkg : Boolean := False;
3035 Add_Before_First_Case : Boolean := False)
3037 Real_Parent : Project_Node_Id;
3038 New_Decl, Decl, Next : Project_Node_Id;
3039 Last, L : Project_Node_Id;
3042 if Kind_Of (Expr, Tree) /= N_Declarative_Item then
3043 New_Decl := Default_Project_Node (Tree, N_Declarative_Item);
3044 Set_Current_Item_Node (New_Decl, Tree, Expr);
3049 if Kind_Of (Parent, Tree) = N_Project then
3050 Real_Parent := Project_Declaration_Of (Parent, Tree);
3052 Real_Parent := Parent;
3055 Decl := First_Declarative_Item_Of (Real_Parent, Tree);
3057 if Decl = Empty_Node then
3058 Set_First_Declarative_Item_Of (Real_Parent, Tree, New_Decl);
3061 Next := Next_Declarative_Item (Decl, Tree);
3062 exit when Next = Empty_Node
3064 (Add_Before_First_Pkg
3065 and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
3066 N_Package_Declaration)
3068 (Add_Before_First_Case
3069 and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
3070 N_Case_Construction);
3074 -- In case Expr is in fact a range of declarative items
3078 L := Next_Declarative_Item (Last, Tree);
3079 exit when L = Empty_Node;
3083 -- In case Expr is in fact a range of declarative items
3087 L := Next_Declarative_Item (Last, Tree);
3088 exit when L = Empty_Node;
3092 Set_Next_Declarative_Item (Last, Tree, Next);
3093 Set_Next_Declarative_Item (Decl, Tree, New_Decl);
3097 ---------------------------
3098 -- Create_Literal_String --
3099 ---------------------------
3101 function Create_Literal_String
3102 (Str : Namet.Name_Id;
3103 Tree : Project_Node_Tree_Ref) return Project_Node_Id
3105 Node : Project_Node_Id;
3107 Node := Default_Project_Node (Tree, N_Literal_String, Prj.Single);
3108 Set_Next_Literal_String (Node, Tree, Empty_Node);
3109 Set_String_Value_Of (Node, Tree, Str);
3111 end Create_Literal_String;
3113 ---------------------------
3114 -- Enclose_In_Expression --
3115 ---------------------------
3117 function Enclose_In_Expression
3118 (Node : Project_Node_Id;
3119 Tree : Project_Node_Tree_Ref) return Project_Node_Id
3121 Expr : Project_Node_Id;
3123 if Kind_Of (Node, Tree) /= N_Expression then
3124 Expr := Default_Project_Node (Tree, N_Expression, Single);
3126 (Expr, Tree, Default_Project_Node (Tree, N_Term, Single));
3127 Set_Current_Term (First_Term (Expr, Tree), Tree, Node);
3132 end Enclose_In_Expression;
3134 --------------------
3135 -- Create_Package --
3136 --------------------
3138 function Create_Package
3139 (Tree : Project_Node_Tree_Ref;
3140 Project : Project_Node_Id;
3141 Pkg : String) return Project_Node_Id
3143 Pack : Project_Node_Id;
3147 Name_Len := Pkg'Length;
3148 Name_Buffer (1 .. Name_Len) := Pkg;
3151 -- Check if the package already exists
3153 Pack := First_Package_Of (Project, Tree);
3154 while Pack /= Empty_Node loop
3155 if Prj.Tree.Name_Of (Pack, Tree) = N then
3159 Pack := Next_Package_In_Project (Pack, Tree);
3162 -- Create the package and add it to the declarative item
3164 Pack := Default_Project_Node (Tree, N_Package_Declaration);
3165 Set_Name_Of (Pack, Tree, N);
3167 -- Find the correct package id to use
3169 Set_Package_Id_Of (Pack, Tree, Package_Node_Id_Of (N));
3171 -- Add it to the list of packages
3173 Set_Next_Package_In_Project
3174 (Pack, Tree, First_Package_Of (Project, Tree));
3175 Set_First_Package_Of (Project, Tree, Pack);
3177 Add_At_End (Tree, Project_Declaration_Of (Project, Tree), Pack);
3182 ----------------------
3183 -- Create_Attribute --
3184 ----------------------
3186 function Create_Attribute
3187 (Tree : Project_Node_Tree_Ref;
3188 Prj_Or_Pkg : Project_Node_Id;
3190 Index_Name : Name_Id := No_Name;
3191 Kind : Variable_Kind := List;
3192 At_Index : Integer := 0;
3193 Value : Project_Node_Id := Empty_Node) return Project_Node_Id
3195 Node : constant Project_Node_Id :=
3196 Default_Project_Node (Tree, N_Attribute_Declaration, Kind);
3198 Case_Insensitive : Boolean;
3200 Pkg : Package_Node_Id;
3201 Start_At : Attribute_Node_Id;
3202 Expr : Project_Node_Id;
3205 Set_Name_Of (Node, Tree, Name);
3207 if Index_Name /= No_Name then
3208 Set_Associative_Array_Index_Of (Node, Tree, Index_Name);
3211 if Prj_Or_Pkg /= Empty_Node then
3212 Add_At_End (Tree, Prj_Or_Pkg, Node);
3215 -- Find out the case sensitivity of the attribute
3217 if Prj_Or_Pkg /= Empty_Node
3218 and then Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration
3220 Pkg := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree));
3221 Start_At := First_Attribute_Of (Pkg);
3223 Start_At := Attribute_First;
3226 Start_At := Attribute_Node_Id_Of (Name, Start_At);
3228 Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array;
3229 Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive;
3231 if At_Index /= 0 then
3232 if Attribute_Kind_Of (Start_At) =
3233 Optional_Index_Associative_Array
3234 or else Attribute_Kind_Of (Start_At) =
3235 Optional_Index_Case_Insensitive_Associative_Array
3237 -- Results in: for Name ("index" at index) use "value";
3238 -- This is currently only used for executables.
3240 Set_Source_Index_Of (Node, Tree, To => Int (At_Index));
3243 -- Results in: for Name ("index") use "value" at index;
3245 -- ??? This limitation makes no sense, we should be able to
3246 -- set the source index on an expression.
3248 pragma Assert (Kind_Of (Value, Tree) = N_Literal_String);
3249 Set_Source_Index_Of (Value, Tree, To => Int (At_Index));
3253 if Value /= Empty_Node then
3254 Expr := Enclose_In_Expression (Value, Tree);
3255 Set_Expression_Of (Node, Tree, Expr);
3259 end Create_Attribute;