1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2007, 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 ------------------------------------------------------------------------------
28 package body Prj
.Tree
is
30 Node_With_Comments
: constant array (Project_Node_Kind
) of Boolean :=
32 N_With_Clause
=> True,
33 N_Project_Declaration
=> False,
34 N_Declarative_Item
=> False,
35 N_Package_Declaration
=> True,
36 N_String_Type_Declaration
=> True,
37 N_Literal_String
=> False,
38 N_Attribute_Declaration
=> True,
39 N_Typed_Variable_Declaration
=> True,
40 N_Variable_Declaration
=> True,
41 N_Expression
=> False,
43 N_Literal_String_List
=> False,
44 N_Variable_Reference
=> False,
45 N_External_Value
=> False,
46 N_Attribute_Reference
=> False,
47 N_Case_Construction
=> True,
49 N_Comment_Zones
=> True,
51 -- Indicates the kinds of node that may have associated comments
53 package Next_End_Nodes
is new Table
.Table
54 (Table_Component_Type
=> Project_Node_Id
,
55 Table_Index_Type
=> Natural,
58 Table_Increment
=> 100,
59 Table_Name
=> "Next_End_Nodes");
60 -- A stack of nodes to indicates to what node the next "end" is associated
62 use Tree_Private_Part
;
64 End_Of_Line_Node
: Project_Node_Id
:= Empty_Node
;
65 -- The node an end of line comment may be associated with
67 Previous_Line_Node
: Project_Node_Id
:= Empty_Node
;
68 -- The node an immediately following comment may be associated with
70 Previous_End_Node
: Project_Node_Id
:= Empty_Node
;
71 -- The node comments immediately following an "end" line may be
74 Unkept_Comments
: Boolean := False;
75 -- Set to True when some comments may not be associated with any node
77 function Comment_Zones_Of
78 (Node
: Project_Node_Id
;
79 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
80 -- Returns the ID of the N_Comment_Zones node associated with node Node.
81 -- If there is not already an N_Comment_Zones node, create one and
82 -- associate it with node Node.
88 procedure Add_Comments
89 (To
: Project_Node_Id
;
90 In_Tree
: Project_Node_Tree_Ref
;
91 Where
: Comment_Location
) is
92 Zone
: Project_Node_Id
:= Empty_Node
;
93 Previous
: Project_Node_Id
:= Empty_Node
;
99 In_Tree
.Project_Nodes
.Table
(To
).Kind
/= N_Comment
);
101 Zone
:= In_Tree
.Project_Nodes
.Table
(To
).Comments
;
103 if Zone
= Empty_Node
then
105 -- Create new N_Comment_Zones node
107 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
108 In_Tree
.Project_Nodes
.Table
109 (Project_Node_Table
.Last
(In_Tree
.Project_Nodes
)) :=
110 (Kind
=> N_Comment_Zones
,
111 Expr_Kind
=> Undefined
,
112 Location
=> No_Location
,
113 Directory
=> No_Path
,
114 Variables
=> Empty_Node
,
115 Packages
=> Empty_Node
,
116 Pkg_Id
=> Empty_Package
,
119 Path_Name
=> No_Path
,
121 Field1
=> Empty_Node
,
122 Field2
=> Empty_Node
,
123 Field3
=> Empty_Node
,
126 Comments
=> Empty_Node
);
128 Zone
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
129 In_Tree
.Project_Nodes
.Table
(To
).Comments
:= Zone
;
132 if Where
= End_Of_Line
then
133 In_Tree
.Project_Nodes
.Table
(Zone
).Value
:= Comments
.Table
(1).Value
;
136 -- Get each comments in the Comments table and link them to node To
138 for J
in 1 .. Comments
.Last
loop
140 -- Create new N_Comment node
142 if (Where
= After
or else Where
= After_End
) and then
143 Token
/= Tok_EOF
and then
144 Comments
.Table
(J
).Follows_Empty_Line
146 Comments
.Table
(1 .. Comments
.Last
- J
+ 1) :=
147 Comments
.Table
(J
.. Comments
.Last
);
148 Comments
.Set_Last
(Comments
.Last
- J
+ 1);
152 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
153 In_Tree
.Project_Nodes
.Table
154 (Project_Node_Table
.Last
(In_Tree
.Project_Nodes
)) :=
156 Expr_Kind
=> Undefined
,
157 Flag1
=> Comments
.Table
(J
).Follows_Empty_Line
,
159 Comments
.Table
(J
).Is_Followed_By_Empty_Line
,
160 Location
=> No_Location
,
161 Directory
=> No_Path
,
162 Variables
=> Empty_Node
,
163 Packages
=> Empty_Node
,
164 Pkg_Id
=> Empty_Package
,
167 Path_Name
=> No_Path
,
168 Value
=> Comments
.Table
(J
).Value
,
169 Field1
=> Empty_Node
,
170 Field2
=> Empty_Node
,
171 Field3
=> Empty_Node
,
172 Comments
=> Empty_Node
);
174 -- If this is the first comment, put it in the right field of
177 if Previous
= Empty_Node
then
180 In_Tree
.Project_Nodes
.Table
(Zone
).Field1
:=
181 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
184 In_Tree
.Project_Nodes
.Table
(Zone
).Field2
:=
185 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
188 In_Tree
.Project_Nodes
.Table
(Zone
).Field3
:=
189 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
192 In_Tree
.Project_Nodes
.Table
(Zone
).Comments
:=
193 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
200 -- When it is not the first, link it to the previous one
202 In_Tree
.Project_Nodes
.Table
(Previous
).Comments
:=
203 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
206 -- This node becomes the previous one for the next comment, if
209 Previous
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
213 -- Empty the Comments table, so that there is no risk to link the same
214 -- comments to another node.
216 Comments
.Set_Last
(0);
219 --------------------------------
220 -- Associative_Array_Index_Of --
221 --------------------------------
223 function Associative_Array_Index_Of
224 (Node
: Project_Node_Id
;
225 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
231 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
233 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
234 return In_Tree
.Project_Nodes
.Table
(Node
).Value
;
235 end Associative_Array_Index_Of
;
237 ----------------------------
238 -- Associative_Package_Of --
239 ----------------------------
241 function Associative_Package_Of
242 (Node
: Project_Node_Id
;
243 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
249 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
));
250 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
251 end Associative_Package_Of
;
253 ----------------------------
254 -- Associative_Project_Of --
255 ----------------------------
257 function Associative_Project_Of
258 (Node
: Project_Node_Id
;
259 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
265 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
));
266 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
267 end Associative_Project_Of
;
269 ----------------------
270 -- Case_Insensitive --
271 ----------------------
273 function Case_Insensitive
274 (Node
: Project_Node_Id
;
275 In_Tree
: Project_Node_Tree_Ref
) return Boolean is
280 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
282 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
283 return In_Tree
.Project_Nodes
.Table
(Node
).Flag1
;
284 end Case_Insensitive
;
286 --------------------------------
287 -- Case_Variable_Reference_Of --
288 --------------------------------
290 function Case_Variable_Reference_Of
291 (Node
: Project_Node_Id
;
292 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
298 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
299 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
300 end Case_Variable_Reference_Of
;
302 ----------------------
303 -- Comment_Zones_Of --
304 ----------------------
306 function Comment_Zones_Of
307 (Node
: Project_Node_Id
;
308 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
310 Zone
: Project_Node_Id
;
313 pragma Assert
(Node
/= Empty_Node
);
314 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
316 -- If there is not already an N_Comment_Zones associated, create a new
317 -- one and associate it with node Node.
319 if Zone
= Empty_Node
then
320 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
321 Zone
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
322 In_Tree
.Project_Nodes
.Table
(Zone
) :=
323 (Kind
=> N_Comment_Zones
,
324 Location
=> No_Location
,
325 Directory
=> No_Path
,
326 Expr_Kind
=> Undefined
,
327 Variables
=> Empty_Node
,
328 Packages
=> Empty_Node
,
329 Pkg_Id
=> Empty_Package
,
332 Path_Name
=> No_Path
,
334 Field1
=> Empty_Node
,
335 Field2
=> Empty_Node
,
336 Field3
=> Empty_Node
,
339 Comments
=> Empty_Node
);
340 In_Tree
.Project_Nodes
.Table
(Node
).Comments
:= Zone
;
344 end Comment_Zones_Of
;
346 -----------------------
347 -- Current_Item_Node --
348 -----------------------
350 function Current_Item_Node
351 (Node
: Project_Node_Id
;
352 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
358 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
359 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
360 end Current_Item_Node
;
366 function Current_Term
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_Term
);
375 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
378 --------------------------
379 -- Default_Project_Node --
380 --------------------------
382 function Default_Project_Node
383 (In_Tree
: Project_Node_Tree_Ref
;
384 Of_Kind
: Project_Node_Kind
;
385 And_Expr_Kind
: Variable_Kind
:= Undefined
) return Project_Node_Id
387 Result
: Project_Node_Id
;
388 Zone
: Project_Node_Id
;
389 Previous
: Project_Node_Id
;
392 -- Create new node with specified kind and expression kind
394 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
395 In_Tree
.Project_Nodes
.Table
396 (Project_Node_Table
.Last
(In_Tree
.Project_Nodes
)) :=
398 Location
=> No_Location
,
399 Directory
=> No_Path
,
400 Expr_Kind
=> And_Expr_Kind
,
401 Variables
=> Empty_Node
,
402 Packages
=> Empty_Node
,
403 Pkg_Id
=> Empty_Package
,
406 Path_Name
=> No_Path
,
408 Field1
=> Empty_Node
,
409 Field2
=> Empty_Node
,
410 Field3
=> Empty_Node
,
413 Comments
=> Empty_Node
);
415 -- Save the new node for the returned value
417 Result
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
419 if Comments
.Last
> 0 then
421 -- If this is not a node with comments, then set the flag
423 if not Node_With_Comments
(Of_Kind
) then
424 Unkept_Comments
:= True;
426 elsif Of_Kind
/= N_Comment
and then Of_Kind
/= N_Comment_Zones
then
428 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
429 In_Tree
.Project_Nodes
.Table
430 (Project_Node_Table
.Last
(In_Tree
.Project_Nodes
)) :=
431 (Kind
=> N_Comment_Zones
,
432 Expr_Kind
=> Undefined
,
433 Location
=> No_Location
,
434 Directory
=> No_Path
,
435 Variables
=> Empty_Node
,
436 Packages
=> Empty_Node
,
437 Pkg_Id
=> Empty_Package
,
440 Path_Name
=> No_Path
,
442 Field1
=> Empty_Node
,
443 Field2
=> Empty_Node
,
444 Field3
=> Empty_Node
,
447 Comments
=> Empty_Node
);
449 Zone
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
450 In_Tree
.Project_Nodes
.Table
(Result
).Comments
:= Zone
;
451 Previous
:= Empty_Node
;
453 for J
in 1 .. Comments
.Last
loop
455 -- Create a new N_Comment node
457 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
458 In_Tree
.Project_Nodes
.Table
459 (Project_Node_Table
.Last
(In_Tree
.Project_Nodes
)) :=
461 Expr_Kind
=> Undefined
,
462 Flag1
=> Comments
.Table
(J
).Follows_Empty_Line
,
464 Comments
.Table
(J
).Is_Followed_By_Empty_Line
,
465 Location
=> No_Location
,
466 Directory
=> No_Path
,
467 Variables
=> Empty_Node
,
468 Packages
=> Empty_Node
,
469 Pkg_Id
=> Empty_Package
,
472 Path_Name
=> No_Path
,
473 Value
=> Comments
.Table
(J
).Value
,
474 Field1
=> Empty_Node
,
475 Field2
=> Empty_Node
,
476 Field3
=> Empty_Node
,
477 Comments
=> Empty_Node
);
479 -- Link it to the N_Comment_Zones node, if it is the first,
480 -- otherwise to the previous one.
482 if Previous
= Empty_Node
then
483 In_Tree
.Project_Nodes
.Table
(Zone
).Field1
:=
484 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
487 In_Tree
.Project_Nodes
.Table
(Previous
).Comments
:=
488 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
491 -- This new node will be the previous one for the next
492 -- N_Comment node, if there is one.
494 Previous
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
497 -- Empty the Comments table after all comments have been processed
499 Comments
.Set_Last
(0);
504 end Default_Project_Node
;
510 function Directory_Of
511 (Node
: Project_Node_Id
;
512 In_Tree
: Project_Node_Tree_Ref
) return Path_Name_Type
is
517 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
518 return In_Tree
.Project_Nodes
.Table
(Node
).Directory
;
521 -------------------------
522 -- End_Of_Line_Comment --
523 -------------------------
525 function End_Of_Line_Comment
526 (Node
: Project_Node_Id
;
527 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
is
528 Zone
: Project_Node_Id
:= Empty_Node
;
531 pragma Assert
(Node
/= Empty_Node
);
532 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
534 if Zone
= Empty_Node
then
537 return In_Tree
.Project_Nodes
.Table
(Zone
).Value
;
539 end End_Of_Line_Comment
;
541 ------------------------
542 -- Expression_Kind_Of --
543 ------------------------
545 function Expression_Kind_Of
546 (Node
: Project_Node_Id
;
547 In_Tree
: Project_Node_Tree_Ref
) return Variable_Kind
is
552 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
554 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
556 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
558 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
559 N_Typed_Variable_Declaration
561 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
563 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
565 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
567 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
569 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
570 N_Attribute_Reference
));
572 return In_Tree
.Project_Nodes
.Table
(Node
).Expr_Kind
;
573 end Expression_Kind_Of
;
579 function Expression_Of
580 (Node
: Project_Node_Id
;
581 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
587 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
588 N_Attribute_Declaration
590 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
591 N_Typed_Variable_Declaration
593 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
594 N_Variable_Declaration
));
596 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
599 -------------------------
600 -- Extended_Project_Of --
601 -------------------------
603 function Extended_Project_Of
604 (Node
: Project_Node_Id
;
605 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
611 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
612 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
613 end Extended_Project_Of
;
615 ------------------------------
616 -- Extended_Project_Path_Of --
617 ------------------------------
619 function Extended_Project_Path_Of
620 (Node
: Project_Node_Id
;
621 In_Tree
: Project_Node_Tree_Ref
) return Path_Name_Type
627 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
628 return Path_Name_Type
(In_Tree
.Project_Nodes
.Table
(Node
).Value
);
629 end Extended_Project_Path_Of
;
631 --------------------------
632 -- Extending_Project_Of --
633 --------------------------
634 function Extending_Project_Of
635 (Node
: Project_Node_Id
;
636 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
642 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
643 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
644 end Extending_Project_Of
;
646 ---------------------------
647 -- External_Reference_Of --
648 ---------------------------
650 function External_Reference_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_External_Value
);
659 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
660 end External_Reference_Of
;
662 -------------------------
663 -- External_Default_Of --
664 -------------------------
666 function External_Default_Of
667 (Node
: Project_Node_Id
;
668 In_Tree
: Project_Node_Tree_Ref
)
669 return Project_Node_Id
675 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
676 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
677 end External_Default_Of
;
679 ------------------------
680 -- First_Case_Item_Of --
681 ------------------------
683 function First_Case_Item_Of
684 (Node
: Project_Node_Id
;
685 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
691 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
692 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
693 end First_Case_Item_Of
;
695 ---------------------
696 -- First_Choice_Of --
697 ---------------------
699 function First_Choice_Of
700 (Node
: Project_Node_Id
;
701 In_Tree
: Project_Node_Tree_Ref
)
702 return Project_Node_Id
708 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
709 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
712 -------------------------
713 -- First_Comment_After --
714 -------------------------
716 function First_Comment_After
717 (Node
: Project_Node_Id
;
718 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
720 Zone
: Project_Node_Id
:= Empty_Node
;
722 pragma Assert
(Node
/= Empty_Node
);
723 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
725 if Zone
= Empty_Node
then
729 return In_Tree
.Project_Nodes
.Table
(Zone
).Field2
;
731 end First_Comment_After
;
733 -----------------------------
734 -- First_Comment_After_End --
735 -----------------------------
737 function First_Comment_After_End
738 (Node
: Project_Node_Id
;
739 In_Tree
: Project_Node_Tree_Ref
)
740 return Project_Node_Id
742 Zone
: Project_Node_Id
:= Empty_Node
;
745 pragma Assert
(Node
/= Empty_Node
);
746 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
748 if Zone
= Empty_Node
then
752 return In_Tree
.Project_Nodes
.Table
(Zone
).Comments
;
754 end First_Comment_After_End
;
756 --------------------------
757 -- First_Comment_Before --
758 --------------------------
760 function First_Comment_Before
761 (Node
: Project_Node_Id
;
762 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
764 Zone
: Project_Node_Id
:= Empty_Node
;
767 pragma Assert
(Node
/= Empty_Node
);
768 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
770 if Zone
= Empty_Node
then
774 return In_Tree
.Project_Nodes
.Table
(Zone
).Field1
;
776 end First_Comment_Before
;
778 ------------------------------
779 -- First_Comment_Before_End --
780 ------------------------------
782 function First_Comment_Before_End
783 (Node
: Project_Node_Id
;
784 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
786 Zone
: Project_Node_Id
:= Empty_Node
;
789 pragma Assert
(Node
/= Empty_Node
);
790 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
792 if Zone
= Empty_Node
then
796 return In_Tree
.Project_Nodes
.Table
(Zone
).Field3
;
798 end First_Comment_Before_End
;
800 -------------------------------
801 -- First_Declarative_Item_Of --
802 -------------------------------
804 function First_Declarative_Item_Of
805 (Node
: Project_Node_Id
;
806 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
812 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
814 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
816 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
818 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
then
819 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
821 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
823 end First_Declarative_Item_Of
;
825 ------------------------------
826 -- First_Expression_In_List --
827 ------------------------------
829 function First_Expression_In_List
830 (Node
: Project_Node_Id
;
831 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
837 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String_List
);
838 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
839 end First_Expression_In_List
;
841 --------------------------
842 -- First_Literal_String --
843 --------------------------
845 function First_Literal_String
846 (Node
: Project_Node_Id
;
847 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
853 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
854 N_String_Type_Declaration
);
855 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
856 end First_Literal_String
;
858 ----------------------
859 -- First_Package_Of --
860 ----------------------
862 function First_Package_Of
863 (Node
: Project_Node_Id
;
864 In_Tree
: Project_Node_Tree_Ref
) return Package_Declaration_Id
870 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
871 return In_Tree
.Project_Nodes
.Table
(Node
).Packages
;
872 end First_Package_Of
;
874 --------------------------
875 -- First_String_Type_Of --
876 --------------------------
878 function First_String_Type_Of
879 (Node
: Project_Node_Id
;
880 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
886 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
887 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
888 end First_String_Type_Of
;
895 (Node
: Project_Node_Id
;
896 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
902 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
903 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
906 -----------------------
907 -- First_Variable_Of --
908 -----------------------
910 function First_Variable_Of
911 (Node
: Project_Node_Id
;
912 In_Tree
: Project_Node_Tree_Ref
) return Variable_Node_Id
918 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
920 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
922 return In_Tree
.Project_Nodes
.Table
(Node
).Variables
;
923 end First_Variable_Of
;
925 --------------------------
926 -- First_With_Clause_Of --
927 --------------------------
929 function First_With_Clause_Of
930 (Node
: Project_Node_Id
;
931 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
937 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
938 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
939 end First_With_Clause_Of
;
941 ------------------------
942 -- Follows_Empty_Line --
943 ------------------------
945 function Follows_Empty_Line
946 (Node
: Project_Node_Id
;
947 In_Tree
: Project_Node_Tree_Ref
) return Boolean is
952 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
953 return In_Tree
.Project_Nodes
.Table
(Node
).Flag1
;
954 end Follows_Empty_Line
;
960 function Hash
(N
: Project_Node_Id
) return Header_Num
is
962 return Header_Num
(N
mod Project_Node_Id
(Header_Num
'Last));
969 procedure Initialize
(Tree
: Project_Node_Tree_Ref
) is
971 Project_Node_Table
.Init
(Tree
.Project_Nodes
);
972 Projects_Htable
.Reset
(Tree
.Projects_HT
);
975 -------------------------------
976 -- Is_Followed_By_Empty_Line --
977 -------------------------------
979 function Is_Followed_By_Empty_Line
980 (Node
: Project_Node_Id
;
981 In_Tree
: Project_Node_Tree_Ref
) return Boolean
987 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
988 return In_Tree
.Project_Nodes
.Table
(Node
).Flag2
;
989 end Is_Followed_By_Empty_Line
;
991 ----------------------
992 -- Is_Extending_All --
993 ----------------------
995 function Is_Extending_All
996 (Node
: Project_Node_Id
;
997 In_Tree
: Project_Node_Tree_Ref
) return Boolean is
1002 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
1004 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1005 return In_Tree
.Project_Nodes
.Table
(Node
).Flag2
;
1006 end Is_Extending_All
;
1008 -------------------------
1009 -- Is_Not_Last_In_List --
1010 -------------------------
1012 function Is_Not_Last_In_List
1013 (Node
: Project_Node_Id
;
1014 In_Tree
: Project_Node_Tree_Ref
) return Boolean is
1019 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
1020 return In_Tree
.Project_Nodes
.Table
(Node
).Flag1
;
1021 end Is_Not_Last_In_List
;
1023 -------------------------------------
1024 -- Imported_Or_Extended_Project_Of --
1025 -------------------------------------
1027 function Imported_Or_Extended_Project_Of
1028 (Project
: Project_Node_Id
;
1029 In_Tree
: Project_Node_Tree_Ref
;
1030 With_Name
: Name_Id
) return Project_Node_Id
1032 With_Clause
: Project_Node_Id
:=
1033 First_With_Clause_Of
(Project
, In_Tree
);
1034 Result
: Project_Node_Id
:= Empty_Node
;
1037 -- First check all the imported projects
1039 while With_Clause
/= Empty_Node
loop
1041 -- Only non limited imported project may be used as prefix
1042 -- of variable or attributes.
1044 Result
:= Non_Limited_Project_Node_Of
(With_Clause
, In_Tree
);
1045 exit when Result
/= Empty_Node
1046 and then Name_Of
(Result
, In_Tree
) = With_Name
;
1047 With_Clause
:= Next_With_Clause_Of
(With_Clause
, In_Tree
);
1050 -- If it is not an imported project, it might be the imported project
1052 if With_Clause
= Empty_Node
then
1055 (Project_Declaration_Of
(Project
, In_Tree
), In_Tree
);
1057 if Result
/= Empty_Node
1058 and then Name_Of
(Result
, In_Tree
) /= With_Name
1060 Result
:= Empty_Node
;
1065 end Imported_Or_Extended_Project_Of
;
1072 (Node
: Project_Node_Id
;
1073 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Kind
is
1075 pragma Assert
(Node
/= Empty_Node
);
1076 return In_Tree
.Project_Nodes
.Table
(Node
).Kind
;
1083 function Location_Of
1084 (Node
: Project_Node_Id
;
1085 In_Tree
: Project_Node_Tree_Ref
) return Source_Ptr
is
1087 pragma Assert
(Node
/= Empty_Node
);
1088 return In_Tree
.Project_Nodes
.Table
(Node
).Location
;
1096 (Node
: Project_Node_Id
;
1097 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
is
1099 pragma Assert
(Node
/= Empty_Node
);
1100 return In_Tree
.Project_Nodes
.Table
(Node
).Name
;
1103 --------------------
1104 -- Next_Case_Item --
1105 --------------------
1107 function Next_Case_Item
1108 (Node
: Project_Node_Id
;
1109 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1115 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
1116 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1123 function Next_Comment
1124 (Node
: Project_Node_Id
;
1125 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
is
1130 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
1131 return In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
1134 ---------------------------
1135 -- Next_Declarative_Item --
1136 ---------------------------
1138 function Next_Declarative_Item
1139 (Node
: Project_Node_Id
;
1140 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1146 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
1147 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1148 end Next_Declarative_Item
;
1150 -----------------------------
1151 -- Next_Expression_In_List --
1152 -----------------------------
1154 function Next_Expression_In_List
1155 (Node
: Project_Node_Id
;
1156 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1162 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
1163 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1164 end Next_Expression_In_List
;
1166 -------------------------
1167 -- Next_Literal_String --
1168 -------------------------
1170 function Next_Literal_String
1171 (Node
: Project_Node_Id
;
1172 In_Tree
: Project_Node_Tree_Ref
)
1173 return Project_Node_Id
1179 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
);
1180 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
1181 end Next_Literal_String
;
1183 -----------------------------
1184 -- Next_Package_In_Project --
1185 -----------------------------
1187 function Next_Package_In_Project
1188 (Node
: Project_Node_Id
;
1189 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1195 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1196 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1197 end Next_Package_In_Project
;
1199 ----------------------
1200 -- Next_String_Type --
1201 ----------------------
1203 function Next_String_Type
1204 (Node
: Project_Node_Id
;
1205 In_Tree
: Project_Node_Tree_Ref
)
1206 return Project_Node_Id
1212 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1213 N_String_Type_Declaration
);
1214 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1215 end Next_String_Type
;
1222 (Node
: Project_Node_Id
;
1223 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1229 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
);
1230 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1237 function Next_Variable
1238 (Node
: Project_Node_Id
;
1239 In_Tree
: Project_Node_Tree_Ref
)
1240 return Project_Node_Id
1246 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1247 N_Typed_Variable_Declaration
1249 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1250 N_Variable_Declaration
));
1252 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1255 -------------------------
1256 -- Next_With_Clause_Of --
1257 -------------------------
1259 function Next_With_Clause_Of
1260 (Node
: Project_Node_Id
;
1261 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1267 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
1268 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1269 end Next_With_Clause_Of
;
1271 ---------------------------------
1272 -- Non_Limited_Project_Node_Of --
1273 ---------------------------------
1275 function Non_Limited_Project_Node_Of
1276 (Node
: Project_Node_Id
;
1277 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1283 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1284 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1285 end Non_Limited_Project_Node_Of
;
1291 function Package_Id_Of
1292 (Node
: Project_Node_Id
;
1293 In_Tree
: Project_Node_Tree_Ref
) return Package_Node_Id
1299 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1300 return In_Tree
.Project_Nodes
.Table
(Node
).Pkg_Id
;
1303 ---------------------
1304 -- Package_Node_Of --
1305 ---------------------
1307 function Package_Node_Of
1308 (Node
: Project_Node_Id
;
1309 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1315 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1317 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1318 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1319 end Package_Node_Of
;
1325 function Path_Name_Of
1326 (Node
: Project_Node_Id
;
1327 In_Tree
: Project_Node_Tree_Ref
) return Path_Name_Type
1333 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
1335 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1336 return In_Tree
.Project_Nodes
.Table
(Node
).Path_Name
;
1339 ----------------------------
1340 -- Project_Declaration_Of --
1341 ----------------------------
1343 function Project_Declaration_Of
1344 (Node
: Project_Node_Id
;
1345 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1351 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1352 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1353 end Project_Declaration_Of
;
1355 -------------------------------------------
1356 -- Project_File_Includes_Unkept_Comments --
1357 -------------------------------------------
1359 function Project_File_Includes_Unkept_Comments
1360 (Node
: Project_Node_Id
;
1361 In_Tree
: Project_Node_Tree_Ref
) return Boolean
1363 Declaration
: constant Project_Node_Id
:=
1364 Project_Declaration_Of
(Node
, In_Tree
);
1366 return In_Tree
.Project_Nodes
.Table
(Declaration
).Flag1
;
1367 end Project_File_Includes_Unkept_Comments
;
1369 ---------------------
1370 -- Project_Node_Of --
1371 ---------------------
1373 function Project_Node_Of
1374 (Node
: Project_Node_Id
;
1375 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1381 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
1383 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1385 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1386 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
1387 end Project_Node_Of
;
1389 -----------------------------------
1390 -- Project_Of_Renamed_Package_Of --
1391 -----------------------------------
1393 function Project_Of_Renamed_Package_Of
1394 (Node
: Project_Node_Id
;
1395 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1401 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1402 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
1403 end Project_Of_Renamed_Package_Of
;
1405 --------------------------
1406 -- Remove_Next_End_Node --
1407 --------------------------
1409 procedure Remove_Next_End_Node
is
1411 Next_End_Nodes
.Decrement_Last
;
1412 end Remove_Next_End_Node
;
1418 procedure Reset_State
is
1420 End_Of_Line_Node
:= Empty_Node
;
1421 Previous_Line_Node
:= Empty_Node
;
1422 Previous_End_Node
:= Empty_Node
;
1423 Unkept_Comments
:= False;
1424 Comments
.Set_Last
(0);
1431 procedure Restore
(S
: Comment_State
) is
1433 End_Of_Line_Node
:= S
.End_Of_Line_Node
;
1434 Previous_Line_Node
:= S
.Previous_Line_Node
;
1435 Previous_End_Node
:= S
.Previous_End_Node
;
1436 Next_End_Nodes
.Set_Last
(0);
1437 Unkept_Comments
:= S
.Unkept_Comments
;
1439 Comments
.Set_Last
(0);
1441 for J
in S
.Comments
'Range loop
1442 Comments
.Increment_Last
;
1443 Comments
.Table
(Comments
.Last
) := S
.Comments
(J
);
1451 procedure Save
(S
: out Comment_State
) is
1452 Cmts
: constant Comments_Ptr
:= new Comment_Array
(1 .. Comments
.Last
);
1455 for J
in 1 .. Comments
.Last
loop
1456 Cmts
(J
) := Comments
.Table
(J
);
1460 (End_Of_Line_Node
=> End_Of_Line_Node
,
1461 Previous_Line_Node
=> Previous_Line_Node
,
1462 Previous_End_Node
=> Previous_End_Node
,
1463 Unkept_Comments
=> Unkept_Comments
,
1471 procedure Scan
(In_Tree
: Project_Node_Tree_Ref
) is
1472 Empty_Line
: Boolean := False;
1475 -- If there are comments, then they will not be kept. Set the flag and
1476 -- clear the comments.
1478 if Comments
.Last
> 0 then
1479 Unkept_Comments
:= True;
1480 Comments
.Set_Last
(0);
1483 -- Loop until a token other that End_Of_Line or Comment is found
1486 Prj
.Err
.Scanner
.Scan
;
1489 when Tok_End_Of_Line
=>
1490 if Prev_Token
= Tok_End_Of_Line
then
1493 if Comments
.Last
> 0 then
1494 Comments
.Table
(Comments
.Last
).Is_Followed_By_Empty_Line
1500 -- If this is a line comment, add it to the comment table
1502 if Prev_Token
= Tok_End_Of_Line
1503 or else Prev_Token
= No_Token
1505 Comments
.Increment_Last
;
1506 Comments
.Table
(Comments
.Last
) :=
1507 (Value
=> Comment_Id
,
1508 Follows_Empty_Line
=> Empty_Line
,
1509 Is_Followed_By_Empty_Line
=> False);
1511 -- Otherwise, it is an end of line comment. If there is
1512 -- an end of line node specified, associate the comment with
1515 elsif End_Of_Line_Node
/= Empty_Node
then
1517 Zones
: constant Project_Node_Id
:=
1518 Comment_Zones_Of
(End_Of_Line_Node
, In_Tree
);
1520 In_Tree
.Project_Nodes
.Table
(Zones
).Value
:= Comment_Id
;
1523 -- Otherwise, this end of line node cannot be kept
1526 Unkept_Comments
:= True;
1527 Comments
.Set_Last
(0);
1530 Empty_Line
:= False;
1533 -- If there are comments, where the first comment is not
1534 -- following an empty line, put the initial uninterrupted
1535 -- comment zone with the node of the preceding line (either
1536 -- a Previous_Line or a Previous_End node), if any.
1538 if Comments
.Last
> 0 and then
1539 not Comments
.Table
(1).Follows_Empty_Line
then
1540 if Previous_Line_Node
/= Empty_Node
then
1542 (To
=> Previous_Line_Node
,
1544 In_Tree
=> In_Tree
);
1546 elsif Previous_End_Node
/= Empty_Node
then
1548 (To
=> Previous_End_Node
,
1550 In_Tree
=> In_Tree
);
1554 -- If there are still comments and the token is "end", then
1555 -- put these comments with the Next_End node, if any;
1556 -- otherwise, these comments cannot be kept. Always clear
1559 if Comments
.Last
> 0 and then Token
= Tok_End
then
1560 if Next_End_Nodes
.Last
> 0 then
1562 (To
=> Next_End_Nodes
.Table
(Next_End_Nodes
.Last
),
1563 Where
=> Before_End
,
1564 In_Tree
=> In_Tree
);
1567 Unkept_Comments
:= True;
1570 Comments
.Set_Last
(0);
1573 -- Reset the End_Of_Line, Previous_Line and Previous_End nodes
1574 -- so that they are not used again.
1576 End_Of_Line_Node
:= Empty_Node
;
1577 Previous_Line_Node
:= Empty_Node
;
1578 Previous_End_Node
:= Empty_Node
;
1587 ------------------------------------
1588 -- Set_Associative_Array_Index_Of --
1589 ------------------------------------
1591 procedure Set_Associative_Array_Index_Of
1592 (Node
: Project_Node_Id
;
1593 In_Tree
: Project_Node_Tree_Ref
;
1600 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1602 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1603 In_Tree
.Project_Nodes
.Table
(Node
).Value
:= To
;
1604 end Set_Associative_Array_Index_Of
;
1606 --------------------------------
1607 -- Set_Associative_Package_Of --
1608 --------------------------------
1610 procedure Set_Associative_Package_Of
1611 (Node
: Project_Node_Id
;
1612 In_Tree
: Project_Node_Tree_Ref
;
1613 To
: Project_Node_Id
)
1619 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
);
1620 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
1621 end Set_Associative_Package_Of
;
1623 --------------------------------
1624 -- Set_Associative_Project_Of --
1625 --------------------------------
1627 procedure Set_Associative_Project_Of
1628 (Node
: Project_Node_Id
;
1629 In_Tree
: Project_Node_Tree_Ref
;
1630 To
: Project_Node_Id
)
1636 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1637 N_Attribute_Declaration
));
1638 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
1639 end Set_Associative_Project_Of
;
1641 --------------------------
1642 -- Set_Case_Insensitive --
1643 --------------------------
1645 procedure Set_Case_Insensitive
1646 (Node
: Project_Node_Id
;
1647 In_Tree
: Project_Node_Tree_Ref
;
1654 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1656 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1657 In_Tree
.Project_Nodes
.Table
(Node
).Flag1
:= To
;
1658 end Set_Case_Insensitive
;
1660 ------------------------------------
1661 -- Set_Case_Variable_Reference_Of --
1662 ------------------------------------
1664 procedure Set_Case_Variable_Reference_Of
1665 (Node
: Project_Node_Id
;
1666 In_Tree
: Project_Node_Tree_Ref
;
1667 To
: Project_Node_Id
)
1673 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
1674 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1675 end Set_Case_Variable_Reference_Of
;
1677 ---------------------------
1678 -- Set_Current_Item_Node --
1679 ---------------------------
1681 procedure Set_Current_Item_Node
1682 (Node
: Project_Node_Id
;
1683 In_Tree
: Project_Node_Tree_Ref
;
1684 To
: Project_Node_Id
)
1690 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
1691 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1692 end Set_Current_Item_Node
;
1694 ----------------------
1695 -- Set_Current_Term --
1696 ----------------------
1698 procedure Set_Current_Term
1699 (Node
: Project_Node_Id
;
1700 In_Tree
: Project_Node_Tree_Ref
;
1701 To
: Project_Node_Id
)
1707 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
);
1708 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1709 end Set_Current_Term
;
1711 ----------------------
1712 -- Set_Directory_Of --
1713 ----------------------
1715 procedure Set_Directory_Of
1716 (Node
: Project_Node_Id
;
1717 In_Tree
: Project_Node_Tree_Ref
;
1718 To
: Path_Name_Type
)
1724 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1725 In_Tree
.Project_Nodes
.Table
(Node
).Directory
:= To
;
1726 end Set_Directory_Of
;
1728 ---------------------
1729 -- Set_End_Of_Line --
1730 ---------------------
1732 procedure Set_End_Of_Line
(To
: Project_Node_Id
) is
1734 End_Of_Line_Node
:= To
;
1735 end Set_End_Of_Line
;
1737 ----------------------------
1738 -- Set_Expression_Kind_Of --
1739 ----------------------------
1741 procedure Set_Expression_Kind_Of
1742 (Node
: Project_Node_Id
;
1743 In_Tree
: Project_Node_Tree_Ref
;
1750 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
1752 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1754 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
1756 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1757 N_Typed_Variable_Declaration
1759 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
1761 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
1763 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
1765 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1767 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1768 N_Attribute_Reference
));
1769 In_Tree
.Project_Nodes
.Table
(Node
).Expr_Kind
:= To
;
1770 end Set_Expression_Kind_Of
;
1772 -----------------------
1773 -- Set_Expression_Of --
1774 -----------------------
1776 procedure Set_Expression_Of
1777 (Node
: Project_Node_Id
;
1778 In_Tree
: Project_Node_Tree_Ref
;
1779 To
: Project_Node_Id
)
1785 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1786 N_Attribute_Declaration
1788 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1789 N_Typed_Variable_Declaration
1791 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1792 N_Variable_Declaration
));
1793 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1794 end Set_Expression_Of
;
1796 -------------------------------
1797 -- Set_External_Reference_Of --
1798 -------------------------------
1800 procedure Set_External_Reference_Of
1801 (Node
: Project_Node_Id
;
1802 In_Tree
: Project_Node_Tree_Ref
;
1803 To
: Project_Node_Id
)
1809 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
1810 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1811 end Set_External_Reference_Of
;
1813 -----------------------------
1814 -- Set_External_Default_Of --
1815 -----------------------------
1817 procedure Set_External_Default_Of
1818 (Node
: Project_Node_Id
;
1819 In_Tree
: Project_Node_Tree_Ref
;
1820 To
: Project_Node_Id
)
1826 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
1827 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
1828 end Set_External_Default_Of
;
1830 ----------------------------
1831 -- Set_First_Case_Item_Of --
1832 ----------------------------
1834 procedure Set_First_Case_Item_Of
1835 (Node
: Project_Node_Id
;
1836 In_Tree
: Project_Node_Tree_Ref
;
1837 To
: Project_Node_Id
)
1843 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
1844 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
1845 end Set_First_Case_Item_Of
;
1847 -------------------------
1848 -- Set_First_Choice_Of --
1849 -------------------------
1851 procedure Set_First_Choice_Of
1852 (Node
: Project_Node_Id
;
1853 In_Tree
: Project_Node_Tree_Ref
;
1854 To
: Project_Node_Id
)
1860 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
1861 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1862 end Set_First_Choice_Of
;
1864 -----------------------------
1865 -- Set_First_Comment_After --
1866 -----------------------------
1868 procedure Set_First_Comment_After
1869 (Node
: Project_Node_Id
;
1870 In_Tree
: Project_Node_Tree_Ref
;
1871 To
: Project_Node_Id
)
1873 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
1875 In_Tree
.Project_Nodes
.Table
(Zone
).Field2
:= To
;
1876 end Set_First_Comment_After
;
1878 ---------------------------------
1879 -- Set_First_Comment_After_End --
1880 ---------------------------------
1882 procedure Set_First_Comment_After_End
1883 (Node
: Project_Node_Id
;
1884 In_Tree
: Project_Node_Tree_Ref
;
1885 To
: Project_Node_Id
)
1887 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
1889 In_Tree
.Project_Nodes
.Table
(Zone
).Comments
:= To
;
1890 end Set_First_Comment_After_End
;
1892 ------------------------------
1893 -- Set_First_Comment_Before --
1894 ------------------------------
1896 procedure Set_First_Comment_Before
1897 (Node
: Project_Node_Id
;
1898 In_Tree
: Project_Node_Tree_Ref
;
1899 To
: Project_Node_Id
)
1902 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
1904 In_Tree
.Project_Nodes
.Table
(Zone
).Field1
:= To
;
1905 end Set_First_Comment_Before
;
1907 ----------------------------------
1908 -- Set_First_Comment_Before_End --
1909 ----------------------------------
1911 procedure Set_First_Comment_Before_End
1912 (Node
: Project_Node_Id
;
1913 In_Tree
: Project_Node_Tree_Ref
;
1914 To
: Project_Node_Id
)
1916 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
1918 In_Tree
.Project_Nodes
.Table
(Zone
).Field2
:= To
;
1919 end Set_First_Comment_Before_End
;
1921 ------------------------
1922 -- Set_Next_Case_Item --
1923 ------------------------
1925 procedure Set_Next_Case_Item
1926 (Node
: Project_Node_Id
;
1927 In_Tree
: Project_Node_Tree_Ref
;
1928 To
: Project_Node_Id
)
1934 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
1935 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
1936 end Set_Next_Case_Item
;
1938 ----------------------
1939 -- Set_Next_Comment --
1940 ----------------------
1942 procedure Set_Next_Comment
1943 (Node
: Project_Node_Id
;
1944 In_Tree
: Project_Node_Tree_Ref
;
1945 To
: Project_Node_Id
)
1951 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
1952 In_Tree
.Project_Nodes
.Table
(Node
).Comments
:= To
;
1953 end Set_Next_Comment
;
1955 -----------------------------------
1956 -- Set_First_Declarative_Item_Of --
1957 -----------------------------------
1959 procedure Set_First_Declarative_Item_Of
1960 (Node
: Project_Node_Id
;
1961 In_Tree
: Project_Node_Tree_Ref
;
1962 To
: Project_Node_Id
)
1968 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
1970 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
1972 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
1974 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
then
1975 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1977 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
1979 end Set_First_Declarative_Item_Of
;
1981 ----------------------------------
1982 -- Set_First_Expression_In_List --
1983 ----------------------------------
1985 procedure Set_First_Expression_In_List
1986 (Node
: Project_Node_Id
;
1987 In_Tree
: Project_Node_Tree_Ref
;
1988 To
: Project_Node_Id
)
1994 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String_List
);
1995 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1996 end Set_First_Expression_In_List
;
1998 ------------------------------
1999 -- Set_First_Literal_String --
2000 ------------------------------
2002 procedure Set_First_Literal_String
2003 (Node
: Project_Node_Id
;
2004 In_Tree
: Project_Node_Tree_Ref
;
2005 To
: Project_Node_Id
)
2011 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2012 N_String_Type_Declaration
);
2013 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2014 end Set_First_Literal_String
;
2016 --------------------------
2017 -- Set_First_Package_Of --
2018 --------------------------
2020 procedure Set_First_Package_Of
2021 (Node
: Project_Node_Id
;
2022 In_Tree
: Project_Node_Tree_Ref
;
2023 To
: Package_Declaration_Id
)
2029 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2030 In_Tree
.Project_Nodes
.Table
(Node
).Packages
:= To
;
2031 end Set_First_Package_Of
;
2033 ------------------------------
2034 -- Set_First_String_Type_Of --
2035 ------------------------------
2037 procedure Set_First_String_Type_Of
2038 (Node
: Project_Node_Id
;
2039 In_Tree
: Project_Node_Tree_Ref
;
2040 To
: Project_Node_Id
)
2046 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2047 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2048 end Set_First_String_Type_Of
;
2050 --------------------
2051 -- Set_First_Term --
2052 --------------------
2054 procedure Set_First_Term
2055 (Node
: Project_Node_Id
;
2056 In_Tree
: Project_Node_Tree_Ref
;
2057 To
: Project_Node_Id
)
2063 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
2064 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2067 ---------------------------
2068 -- Set_First_Variable_Of --
2069 ---------------------------
2071 procedure Set_First_Variable_Of
2072 (Node
: Project_Node_Id
;
2073 In_Tree
: Project_Node_Tree_Ref
;
2074 To
: Variable_Node_Id
)
2080 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
2082 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
2083 In_Tree
.Project_Nodes
.Table
(Node
).Variables
:= To
;
2084 end Set_First_Variable_Of
;
2086 ------------------------------
2087 -- Set_First_With_Clause_Of --
2088 ------------------------------
2090 procedure Set_First_With_Clause_Of
2091 (Node
: Project_Node_Id
;
2092 In_Tree
: Project_Node_Tree_Ref
;
2093 To
: Project_Node_Id
)
2099 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2100 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2101 end Set_First_With_Clause_Of
;
2103 --------------------------
2104 -- Set_Is_Extending_All --
2105 --------------------------
2107 procedure Set_Is_Extending_All
2108 (Node
: Project_Node_Id
;
2109 In_Tree
: Project_Node_Tree_Ref
)
2115 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
2117 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
2118 In_Tree
.Project_Nodes
.Table
(Node
).Flag2
:= True;
2119 end Set_Is_Extending_All
;
2121 -----------------------------
2122 -- Set_Is_Not_Last_In_List --
2123 -----------------------------
2125 procedure Set_Is_Not_Last_In_List
2126 (Node
: Project_Node_Id
;
2127 In_Tree
: Project_Node_Tree_Ref
)
2133 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
2134 In_Tree
.Project_Nodes
.Table
(Node
).Flag1
:= True;
2135 end Set_Is_Not_Last_In_List
;
2141 procedure Set_Kind_Of
2142 (Node
: Project_Node_Id
;
2143 In_Tree
: Project_Node_Tree_Ref
;
2144 To
: Project_Node_Kind
)
2147 pragma Assert
(Node
/= Empty_Node
);
2148 In_Tree
.Project_Nodes
.Table
(Node
).Kind
:= To
;
2151 ---------------------
2152 -- Set_Location_Of --
2153 ---------------------
2155 procedure Set_Location_Of
2156 (Node
: Project_Node_Id
;
2157 In_Tree
: Project_Node_Tree_Ref
;
2161 pragma Assert
(Node
/= Empty_Node
);
2162 In_Tree
.Project_Nodes
.Table
(Node
).Location
:= To
;
2163 end Set_Location_Of
;
2165 -----------------------------
2166 -- Set_Extended_Project_Of --
2167 -----------------------------
2169 procedure Set_Extended_Project_Of
2170 (Node
: Project_Node_Id
;
2171 In_Tree
: Project_Node_Tree_Ref
;
2172 To
: Project_Node_Id
)
2178 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
2179 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2180 end Set_Extended_Project_Of
;
2182 ----------------------------------
2183 -- Set_Extended_Project_Path_Of --
2184 ----------------------------------
2186 procedure Set_Extended_Project_Path_Of
2187 (Node
: Project_Node_Id
;
2188 In_Tree
: Project_Node_Tree_Ref
;
2189 To
: Path_Name_Type
)
2195 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2196 In_Tree
.Project_Nodes
.Table
(Node
).Value
:= Name_Id
(To
);
2197 end Set_Extended_Project_Path_Of
;
2199 ------------------------------
2200 -- Set_Extending_Project_Of --
2201 ------------------------------
2203 procedure Set_Extending_Project_Of
2204 (Node
: Project_Node_Id
;
2205 In_Tree
: Project_Node_Tree_Ref
;
2206 To
: Project_Node_Id
)
2212 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
2213 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2214 end Set_Extending_Project_Of
;
2220 procedure Set_Name_Of
2221 (Node
: Project_Node_Id
;
2222 In_Tree
: Project_Node_Tree_Ref
;
2226 pragma Assert
(Node
/= Empty_Node
);
2227 In_Tree
.Project_Nodes
.Table
(Node
).Name
:= To
;
2230 -------------------------------
2231 -- Set_Next_Declarative_Item --
2232 -------------------------------
2234 procedure Set_Next_Declarative_Item
2235 (Node
: Project_Node_Id
;
2236 In_Tree
: Project_Node_Tree_Ref
;
2237 To
: Project_Node_Id
)
2243 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
2244 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2245 end Set_Next_Declarative_Item
;
2247 -----------------------
2248 -- Set_Next_End_Node --
2249 -----------------------
2251 procedure Set_Next_End_Node
(To
: Project_Node_Id
) is
2253 Next_End_Nodes
.Increment_Last
;
2254 Next_End_Nodes
.Table
(Next_End_Nodes
.Last
) := To
;
2255 end Set_Next_End_Node
;
2257 ---------------------------------
2258 -- Set_Next_Expression_In_List --
2259 ---------------------------------
2261 procedure Set_Next_Expression_In_List
2262 (Node
: Project_Node_Id
;
2263 In_Tree
: Project_Node_Tree_Ref
;
2264 To
: Project_Node_Id
)
2270 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
2271 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2272 end Set_Next_Expression_In_List
;
2274 -----------------------------
2275 -- Set_Next_Literal_String --
2276 -----------------------------
2278 procedure Set_Next_Literal_String
2279 (Node
: Project_Node_Id
;
2280 In_Tree
: Project_Node_Tree_Ref
;
2281 To
: Project_Node_Id
)
2287 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
);
2288 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2289 end Set_Next_Literal_String
;
2291 ---------------------------------
2292 -- Set_Next_Package_In_Project --
2293 ---------------------------------
2295 procedure Set_Next_Package_In_Project
2296 (Node
: Project_Node_Id
;
2297 In_Tree
: Project_Node_Tree_Ref
;
2298 To
: Project_Node_Id
)
2304 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2305 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2306 end Set_Next_Package_In_Project
;
2308 --------------------------
2309 -- Set_Next_String_Type --
2310 --------------------------
2312 procedure Set_Next_String_Type
2313 (Node
: Project_Node_Id
;
2314 In_Tree
: Project_Node_Tree_Ref
;
2315 To
: Project_Node_Id
)
2321 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2322 N_String_Type_Declaration
);
2323 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2324 end Set_Next_String_Type
;
2330 procedure Set_Next_Term
2331 (Node
: Project_Node_Id
;
2332 In_Tree
: Project_Node_Tree_Ref
;
2333 To
: Project_Node_Id
)
2339 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
);
2340 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2343 -----------------------
2344 -- Set_Next_Variable --
2345 -----------------------
2347 procedure Set_Next_Variable
2348 (Node
: Project_Node_Id
;
2349 In_Tree
: Project_Node_Tree_Ref
;
2350 To
: Project_Node_Id
)
2356 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2357 N_Typed_Variable_Declaration
2359 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2360 N_Variable_Declaration
));
2361 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2362 end Set_Next_Variable
;
2364 -----------------------------
2365 -- Set_Next_With_Clause_Of --
2366 -----------------------------
2368 procedure Set_Next_With_Clause_Of
2369 (Node
: Project_Node_Id
;
2370 In_Tree
: Project_Node_Tree_Ref
;
2371 To
: Project_Node_Id
)
2377 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
2378 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2379 end Set_Next_With_Clause_Of
;
2381 -----------------------
2382 -- Set_Package_Id_Of --
2383 -----------------------
2385 procedure Set_Package_Id_Of
2386 (Node
: Project_Node_Id
;
2387 In_Tree
: Project_Node_Tree_Ref
;
2388 To
: Package_Node_Id
)
2394 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2395 In_Tree
.Project_Nodes
.Table
(Node
).Pkg_Id
:= To
;
2396 end Set_Package_Id_Of
;
2398 -------------------------
2399 -- Set_Package_Node_Of --
2400 -------------------------
2402 procedure Set_Package_Node_Of
2403 (Node
: Project_Node_Id
;
2404 In_Tree
: Project_Node_Tree_Ref
;
2405 To
: Project_Node_Id
)
2411 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2413 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
2414 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2415 end Set_Package_Node_Of
;
2417 ----------------------
2418 -- Set_Path_Name_Of --
2419 ----------------------
2421 procedure Set_Path_Name_Of
2422 (Node
: Project_Node_Id
;
2423 In_Tree
: Project_Node_Tree_Ref
;
2424 To
: Path_Name_Type
)
2430 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
2432 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
2433 In_Tree
.Project_Nodes
.Table
(Node
).Path_Name
:= To
;
2434 end Set_Path_Name_Of
;
2436 ---------------------------
2437 -- Set_Previous_End_Node --
2438 ---------------------------
2439 procedure Set_Previous_End_Node
(To
: Project_Node_Id
) is
2441 Previous_End_Node
:= To
;
2442 end Set_Previous_End_Node
;
2444 ----------------------------
2445 -- Set_Previous_Line_Node --
2446 ----------------------------
2448 procedure Set_Previous_Line_Node
(To
: Project_Node_Id
) is
2450 Previous_Line_Node
:= To
;
2451 end Set_Previous_Line_Node
;
2453 --------------------------------
2454 -- Set_Project_Declaration_Of --
2455 --------------------------------
2457 procedure Set_Project_Declaration_Of
2458 (Node
: Project_Node_Id
;
2459 In_Tree
: Project_Node_Tree_Ref
;
2460 To
: Project_Node_Id
)
2466 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2467 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2468 end Set_Project_Declaration_Of
;
2470 -----------------------------------------------
2471 -- Set_Project_File_Includes_Unkept_Comments --
2472 -----------------------------------------------
2474 procedure Set_Project_File_Includes_Unkept_Comments
2475 (Node
: Project_Node_Id
;
2476 In_Tree
: Project_Node_Tree_Ref
;
2479 Declaration
: constant Project_Node_Id
:=
2480 Project_Declaration_Of
(Node
, In_Tree
);
2482 In_Tree
.Project_Nodes
.Table
(Declaration
).Flag1
:= To
;
2483 end Set_Project_File_Includes_Unkept_Comments
;
2485 -------------------------
2486 -- Set_Project_Node_Of --
2487 -------------------------
2489 procedure Set_Project_Node_Of
2490 (Node
: Project_Node_Id
;
2491 In_Tree
: Project_Node_Tree_Ref
;
2492 To
: Project_Node_Id
;
2493 Limited_With
: Boolean := False)
2499 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2501 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2503 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
2504 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2506 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2507 and then not Limited_With
2509 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2511 end Set_Project_Node_Of
;
2513 ---------------------------------------
2514 -- Set_Project_Of_Renamed_Package_Of --
2515 ---------------------------------------
2517 procedure Set_Project_Of_Renamed_Package_Of
2518 (Node
: Project_Node_Id
;
2519 In_Tree
: Project_Node_Tree_Ref
;
2520 To
: Project_Node_Id
)
2526 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2527 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2528 end Set_Project_Of_Renamed_Package_Of
;
2530 -------------------------
2531 -- Set_Source_Index_Of --
2532 -------------------------
2534 procedure Set_Source_Index_Of
2535 (Node
: Project_Node_Id
;
2536 In_Tree
: Project_Node_Tree_Ref
;
2543 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
2545 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2546 N_Attribute_Declaration
));
2547 In_Tree
.Project_Nodes
.Table
(Node
).Src_Index
:= To
;
2548 end Set_Source_Index_Of
;
2550 ------------------------
2551 -- Set_String_Type_Of --
2552 ------------------------
2554 procedure Set_String_Type_Of
2555 (Node
: Project_Node_Id
;
2556 In_Tree
: Project_Node_Tree_Ref
;
2557 To
: Project_Node_Id
)
2563 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2564 N_Variable_Reference
2566 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2567 N_Typed_Variable_Declaration
)
2569 In_Tree
.Project_Nodes
.Table
(To
).Kind
= N_String_Type_Declaration
);
2571 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
then
2572 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2574 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2576 end Set_String_Type_Of
;
2578 -------------------------
2579 -- Set_String_Value_Of --
2580 -------------------------
2582 procedure Set_String_Value_Of
2583 (Node
: Project_Node_Id
;
2584 In_Tree
: Project_Node_Tree_Ref
;
2591 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2593 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
2595 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
));
2596 In_Tree
.Project_Nodes
.Table
(Node
).Value
:= To
;
2597 end Set_String_Value_Of
;
2599 ---------------------
2600 -- Source_Index_Of --
2601 ---------------------
2603 function Source_Index_Of
2604 (Node
: Project_Node_Id
;
2605 In_Tree
: Project_Node_Tree_Ref
) return Int
2611 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
2613 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2614 N_Attribute_Declaration
));
2615 return In_Tree
.Project_Nodes
.Table
(Node
).Src_Index
;
2616 end Source_Index_Of
;
2618 --------------------
2619 -- String_Type_Of --
2620 --------------------
2622 function String_Type_Of
2623 (Node
: Project_Node_Id
;
2624 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
2630 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2631 N_Variable_Reference
2633 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2634 N_Typed_Variable_Declaration
));
2636 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
then
2637 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
2639 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
2643 ---------------------
2644 -- String_Value_Of --
2645 ---------------------
2647 function String_Value_Of
2648 (Node
: Project_Node_Id
;
2649 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
2655 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2657 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
2659 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
));
2660 return In_Tree
.Project_Nodes
.Table
(Node
).Value
;
2661 end String_Value_Of
;
2663 --------------------
2664 -- Value_Is_Valid --
2665 --------------------
2667 function Value_Is_Valid
2668 (For_Typed_Variable
: Project_Node_Id
;
2669 In_Tree
: Project_Node_Tree_Ref
;
2670 Value
: Name_Id
) return Boolean
2674 (For_Typed_Variable
/= Empty_Node
2676 (In_Tree
.Project_Nodes
.Table
(For_Typed_Variable
).Kind
=
2677 N_Typed_Variable_Declaration
));
2680 Current_String
: Project_Node_Id
:=
2681 First_Literal_String
2682 (String_Type_Of
(For_Typed_Variable
, In_Tree
),
2686 while Current_String
/= Empty_Node
2688 String_Value_Of
(Current_String
, In_Tree
) /= Value
2691 Next_Literal_String
(Current_String
, In_Tree
);
2694 return Current_String
/= Empty_Node
;
2699 -------------------------------
2700 -- There_Are_Unkept_Comments --
2701 -------------------------------
2703 function There_Are_Unkept_Comments
return Boolean is
2705 return Unkept_Comments
;
2706 end There_Are_Unkept_Comments
;