1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2005 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
29 package body Prj
.Tree
is
31 Node_With_Comments
: constant array (Project_Node_Kind
) of Boolean :=
33 N_With_Clause
=> True,
34 N_Project_Declaration
=> False,
35 N_Declarative_Item
=> False,
36 N_Package_Declaration
=> True,
37 N_String_Type_Declaration
=> True,
38 N_Literal_String
=> False,
39 N_Attribute_Declaration
=> True,
40 N_Typed_Variable_Declaration
=> True,
41 N_Variable_Declaration
=> True,
42 N_Expression
=> False,
44 N_Literal_String_List
=> False,
45 N_Variable_Reference
=> False,
46 N_External_Value
=> False,
47 N_Attribute_Reference
=> False,
48 N_Case_Construction
=> True,
50 N_Comment_Zones
=> True,
52 -- Indicates the kinds of node that may have associated comments
54 package Next_End_Nodes
is new Table
.Table
55 (Table_Component_Type
=> Project_Node_Id
,
56 Table_Index_Type
=> Natural,
59 Table_Increment
=> 100,
60 Table_Name
=> "Next_End_Nodes");
61 -- A stack of nodes to indicates to what node the next "end" is associated
63 use Tree_Private_Part
;
65 End_Of_Line_Node
: Project_Node_Id
:= Empty_Node
;
66 -- The node an end of line comment may be associated with
68 Previous_Line_Node
: Project_Node_Id
:= Empty_Node
;
69 -- The node an immediately following comment may be associated with
71 Previous_End_Node
: Project_Node_Id
:= Empty_Node
;
72 -- The node comments immediately following an "end" line may be
75 Unkept_Comments
: Boolean := False;
76 -- Set to True when some comments may not be associated with any node
78 function Comment_Zones_Of
79 (Node
: Project_Node_Id
;
80 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
81 -- Returns the ID of the N_Comment_Zones node associated with node Node.
82 -- If there is not already an N_Comment_Zones node, create one and
83 -- associate it with node Node.
89 procedure Add_Comments
90 (To
: Project_Node_Id
;
91 In_Tree
: Project_Node_Tree_Ref
;
92 Where
: Comment_Location
) is
93 Zone
: Project_Node_Id
:= Empty_Node
;
94 Previous
: Project_Node_Id
:= Empty_Node
;
100 In_Tree
.Project_Nodes
.Table
(To
).Kind
/= N_Comment
);
102 Zone
:= In_Tree
.Project_Nodes
.Table
(To
).Comments
;
104 if Zone
= Empty_Node
then
106 -- Create new N_Comment_Zones node
108 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
109 In_Tree
.Project_Nodes
.Table
110 (Project_Node_Table
.Last
(In_Tree
.Project_Nodes
)) :=
111 (Kind
=> N_Comment_Zones
,
112 Expr_Kind
=> Undefined
,
113 Location
=> No_Location
,
114 Directory
=> No_Name
,
115 Variables
=> Empty_Node
,
116 Packages
=> Empty_Node
,
117 Pkg_Id
=> Empty_Package
,
120 Path_Name
=> No_Name
,
122 Field1
=> Empty_Node
,
123 Field2
=> Empty_Node
,
124 Field3
=> Empty_Node
,
127 Comments
=> Empty_Node
);
129 Zone
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
130 In_Tree
.Project_Nodes
.Table
(To
).Comments
:= Zone
;
133 if Where
= End_Of_Line
then
134 In_Tree
.Project_Nodes
.Table
(Zone
).Value
:= Comments
.Table
(1).Value
;
137 -- Get each comments in the Comments table and link them to node To
139 for J
in 1 .. Comments
.Last
loop
141 -- Create new N_Comment node
143 if (Where
= After
or else Where
= After_End
) and then
144 Token
/= Tok_EOF
and then
145 Comments
.Table
(J
).Follows_Empty_Line
147 Comments
.Table
(1 .. Comments
.Last
- J
+ 1) :=
148 Comments
.Table
(J
.. Comments
.Last
);
149 Comments
.Set_Last
(Comments
.Last
- J
+ 1);
153 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
154 In_Tree
.Project_Nodes
.Table
155 (Project_Node_Table
.Last
(In_Tree
.Project_Nodes
)) :=
157 Expr_Kind
=> Undefined
,
158 Flag1
=> Comments
.Table
(J
).Follows_Empty_Line
,
160 Comments
.Table
(J
).Is_Followed_By_Empty_Line
,
161 Location
=> No_Location
,
162 Directory
=> No_Name
,
163 Variables
=> Empty_Node
,
164 Packages
=> Empty_Node
,
165 Pkg_Id
=> Empty_Package
,
168 Path_Name
=> No_Name
,
169 Value
=> Comments
.Table
(J
).Value
,
170 Field1
=> Empty_Node
,
171 Field2
=> Empty_Node
,
172 Field3
=> Empty_Node
,
173 Comments
=> Empty_Node
);
175 -- If this is the first comment, put it in the right field of
178 if Previous
= Empty_Node
then
181 In_Tree
.Project_Nodes
.Table
(Zone
).Field1
:=
182 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
185 In_Tree
.Project_Nodes
.Table
(Zone
).Field2
:=
186 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
189 In_Tree
.Project_Nodes
.Table
(Zone
).Field3
:=
190 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
193 In_Tree
.Project_Nodes
.Table
(Zone
).Comments
:=
194 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
201 -- When it is not the first, link it to the previous one
203 In_Tree
.Project_Nodes
.Table
(Previous
).Comments
:=
204 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
207 -- This node becomes the previous one for the next comment, if
210 Previous
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
214 -- Empty the Comments table, so that there is no risk to link the same
215 -- comments to another node.
217 Comments
.Set_Last
(0);
220 --------------------------------
221 -- Associative_Array_Index_Of --
222 --------------------------------
224 function Associative_Array_Index_Of
225 (Node
: Project_Node_Id
;
226 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
232 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
234 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
235 return In_Tree
.Project_Nodes
.Table
(Node
).Value
;
236 end Associative_Array_Index_Of
;
238 ----------------------------
239 -- Associative_Package_Of --
240 ----------------------------
242 function Associative_Package_Of
243 (Node
: Project_Node_Id
;
244 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
250 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
));
251 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
252 end Associative_Package_Of
;
254 ----------------------------
255 -- Associative_Project_Of --
256 ----------------------------
258 function Associative_Project_Of
259 (Node
: Project_Node_Id
;
260 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
266 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
));
267 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
268 end Associative_Project_Of
;
270 ----------------------
271 -- Case_Insensitive --
272 ----------------------
274 function Case_Insensitive
275 (Node
: Project_Node_Id
;
276 In_Tree
: Project_Node_Tree_Ref
) return Boolean is
281 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
283 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
284 return In_Tree
.Project_Nodes
.Table
(Node
).Flag1
;
285 end Case_Insensitive
;
287 --------------------------------
288 -- Case_Variable_Reference_Of --
289 --------------------------------
291 function Case_Variable_Reference_Of
292 (Node
: Project_Node_Id
;
293 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
299 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
300 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
301 end Case_Variable_Reference_Of
;
303 ----------------------
304 -- Comment_Zones_Of --
305 ----------------------
307 function Comment_Zones_Of
308 (Node
: Project_Node_Id
;
309 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
311 Zone
: Project_Node_Id
;
314 pragma Assert
(Node
/= Empty_Node
);
315 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
317 -- If there is not already an N_Comment_Zones associated, create a new
318 -- one and associate it with node Node.
320 if Zone
= Empty_Node
then
321 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
322 Zone
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
323 In_Tree
.Project_Nodes
.Table
(Zone
) :=
324 (Kind
=> N_Comment_Zones
,
325 Location
=> No_Location
,
326 Directory
=> No_Name
,
327 Expr_Kind
=> Undefined
,
328 Variables
=> Empty_Node
,
329 Packages
=> Empty_Node
,
330 Pkg_Id
=> Empty_Package
,
333 Path_Name
=> No_Name
,
335 Field1
=> Empty_Node
,
336 Field2
=> Empty_Node
,
337 Field3
=> Empty_Node
,
340 Comments
=> Empty_Node
);
341 In_Tree
.Project_Nodes
.Table
(Node
).Comments
:= Zone
;
345 end Comment_Zones_Of
;
347 -----------------------
348 -- Current_Item_Node --
349 -----------------------
351 function Current_Item_Node
352 (Node
: Project_Node_Id
;
353 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
359 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
360 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
361 end Current_Item_Node
;
367 function Current_Term
368 (Node
: Project_Node_Id
;
369 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
375 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
);
376 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
379 --------------------------
380 -- Default_Project_Node --
381 --------------------------
383 function Default_Project_Node
384 (In_Tree
: Project_Node_Tree_Ref
;
385 Of_Kind
: Project_Node_Kind
;
386 And_Expr_Kind
: Variable_Kind
:= Undefined
) return Project_Node_Id
388 Result
: Project_Node_Id
;
389 Zone
: Project_Node_Id
;
390 Previous
: Project_Node_Id
;
393 -- Create new node with specified kind and expression kind
395 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
396 In_Tree
.Project_Nodes
.Table
397 (Project_Node_Table
.Last
(In_Tree
.Project_Nodes
)) :=
399 Location
=> No_Location
,
400 Directory
=> No_Name
,
401 Expr_Kind
=> And_Expr_Kind
,
402 Variables
=> Empty_Node
,
403 Packages
=> Empty_Node
,
404 Pkg_Id
=> Empty_Package
,
407 Path_Name
=> No_Name
,
409 Field1
=> Empty_Node
,
410 Field2
=> Empty_Node
,
411 Field3
=> Empty_Node
,
414 Comments
=> Empty_Node
);
416 -- Save the new node for the returned value
418 Result
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
420 if Comments
.Last
> 0 then
422 -- If this is not a node with comments, then set the flag
424 if not Node_With_Comments
(Of_Kind
) then
425 Unkept_Comments
:= True;
427 elsif Of_Kind
/= N_Comment
and then Of_Kind
/= N_Comment_Zones
then
429 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
430 In_Tree
.Project_Nodes
.Table
431 (Project_Node_Table
.Last
(In_Tree
.Project_Nodes
)) :=
432 (Kind
=> N_Comment_Zones
,
433 Expr_Kind
=> Undefined
,
434 Location
=> No_Location
,
435 Directory
=> No_Name
,
436 Variables
=> Empty_Node
,
437 Packages
=> Empty_Node
,
438 Pkg_Id
=> Empty_Package
,
441 Path_Name
=> No_Name
,
443 Field1
=> Empty_Node
,
444 Field2
=> Empty_Node
,
445 Field3
=> Empty_Node
,
448 Comments
=> Empty_Node
);
450 Zone
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
451 In_Tree
.Project_Nodes
.Table
(Result
).Comments
:= Zone
;
452 Previous
:= Empty_Node
;
454 for J
in 1 .. Comments
.Last
loop
456 -- Create a new N_Comment node
458 Project_Node_Table
.Increment_Last
(In_Tree
.Project_Nodes
);
459 In_Tree
.Project_Nodes
.Table
460 (Project_Node_Table
.Last
(In_Tree
.Project_Nodes
)) :=
462 Expr_Kind
=> Undefined
,
463 Flag1
=> Comments
.Table
(J
).Follows_Empty_Line
,
465 Comments
.Table
(J
).Is_Followed_By_Empty_Line
,
466 Location
=> No_Location
,
467 Directory
=> No_Name
,
468 Variables
=> Empty_Node
,
469 Packages
=> Empty_Node
,
470 Pkg_Id
=> Empty_Package
,
473 Path_Name
=> No_Name
,
474 Value
=> Comments
.Table
(J
).Value
,
475 Field1
=> Empty_Node
,
476 Field2
=> Empty_Node
,
477 Field3
=> Empty_Node
,
478 Comments
=> Empty_Node
);
480 -- Link it to the N_Comment_Zones node, if it is the first,
481 -- otherwise to the previous one.
483 if Previous
= Empty_Node
then
484 In_Tree
.Project_Nodes
.Table
(Zone
).Field1
:=
485 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
488 In_Tree
.Project_Nodes
.Table
(Previous
).Comments
:=
489 Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
492 -- This new node will be the previous one for the next
493 -- N_Comment node, if there is one.
495 Previous
:= Project_Node_Table
.Last
(In_Tree
.Project_Nodes
);
498 -- Empty the Comments table after all comments have been processed
500 Comments
.Set_Last
(0);
505 end Default_Project_Node
;
511 function Directory_Of
512 (Node
: Project_Node_Id
;
513 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
is
518 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
519 return In_Tree
.Project_Nodes
.Table
(Node
).Directory
;
522 -------------------------
523 -- End_Of_Line_Comment --
524 -------------------------
526 function End_Of_Line_Comment
527 (Node
: Project_Node_Id
;
528 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
is
529 Zone
: Project_Node_Id
:= Empty_Node
;
532 pragma Assert
(Node
/= Empty_Node
);
533 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
535 if Zone
= Empty_Node
then
538 return In_Tree
.Project_Nodes
.Table
(Zone
).Value
;
540 end End_Of_Line_Comment
;
542 ------------------------
543 -- Expression_Kind_Of --
544 ------------------------
546 function Expression_Kind_Of
547 (Node
: Project_Node_Id
;
548 In_Tree
: Project_Node_Tree_Ref
) return Variable_Kind
is
553 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
555 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
557 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
559 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
560 N_Typed_Variable_Declaration
562 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
564 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
566 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
568 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
570 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
571 N_Attribute_Reference
));
573 return In_Tree
.Project_Nodes
.Table
(Node
).Expr_Kind
;
574 end Expression_Kind_Of
;
580 function Expression_Of
581 (Node
: Project_Node_Id
;
582 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
588 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
589 N_Attribute_Declaration
591 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
592 N_Typed_Variable_Declaration
594 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
595 N_Variable_Declaration
));
597 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
600 -------------------------
601 -- Extended_Project_Of --
602 -------------------------
604 function Extended_Project_Of
605 (Node
: Project_Node_Id
;
606 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
612 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
613 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
614 end Extended_Project_Of
;
616 ------------------------------
617 -- Extended_Project_Path_Of --
618 ------------------------------
620 function Extended_Project_Path_Of
621 (Node
: Project_Node_Id
;
622 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
628 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
629 return In_Tree
.Project_Nodes
.Table
(Node
).Value
;
630 end Extended_Project_Path_Of
;
632 --------------------------
633 -- Extending_Project_Of --
634 --------------------------
635 function Extending_Project_Of
636 (Node
: Project_Node_Id
;
637 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
643 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
644 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
645 end Extending_Project_Of
;
647 ---------------------------
648 -- External_Reference_Of --
649 ---------------------------
651 function External_Reference_Of
652 (Node
: Project_Node_Id
;
653 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
659 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
660 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
661 end External_Reference_Of
;
663 -------------------------
664 -- External_Default_Of --
665 -------------------------
667 function External_Default_Of
668 (Node
: Project_Node_Id
;
669 In_Tree
: Project_Node_Tree_Ref
)
670 return Project_Node_Id
676 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
677 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
678 end External_Default_Of
;
680 ------------------------
681 -- First_Case_Item_Of --
682 ------------------------
684 function First_Case_Item_Of
685 (Node
: Project_Node_Id
;
686 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
692 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
693 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
694 end First_Case_Item_Of
;
696 ---------------------
697 -- First_Choice_Of --
698 ---------------------
700 function First_Choice_Of
701 (Node
: Project_Node_Id
;
702 In_Tree
: Project_Node_Tree_Ref
)
703 return Project_Node_Id
709 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
710 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
713 -------------------------
714 -- First_Comment_After --
715 -------------------------
717 function First_Comment_After
718 (Node
: Project_Node_Id
;
719 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
721 Zone
: Project_Node_Id
:= Empty_Node
;
723 pragma Assert
(Node
/= Empty_Node
);
724 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
726 if Zone
= Empty_Node
then
730 return In_Tree
.Project_Nodes
.Table
(Zone
).Field2
;
732 end First_Comment_After
;
734 -----------------------------
735 -- First_Comment_After_End --
736 -----------------------------
738 function First_Comment_After_End
739 (Node
: Project_Node_Id
;
740 In_Tree
: Project_Node_Tree_Ref
)
741 return Project_Node_Id
743 Zone
: Project_Node_Id
:= Empty_Node
;
746 pragma Assert
(Node
/= Empty_Node
);
747 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
749 if Zone
= Empty_Node
then
753 return In_Tree
.Project_Nodes
.Table
(Zone
).Comments
;
755 end First_Comment_After_End
;
757 --------------------------
758 -- First_Comment_Before --
759 --------------------------
761 function First_Comment_Before
762 (Node
: Project_Node_Id
;
763 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
765 Zone
: Project_Node_Id
:= Empty_Node
;
768 pragma Assert
(Node
/= Empty_Node
);
769 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
771 if Zone
= Empty_Node
then
775 return In_Tree
.Project_Nodes
.Table
(Zone
).Field1
;
777 end First_Comment_Before
;
779 ------------------------------
780 -- First_Comment_Before_End --
781 ------------------------------
783 function First_Comment_Before_End
784 (Node
: Project_Node_Id
;
785 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
787 Zone
: Project_Node_Id
:= Empty_Node
;
790 pragma Assert
(Node
/= Empty_Node
);
791 Zone
:= In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
793 if Zone
= Empty_Node
then
797 return In_Tree
.Project_Nodes
.Table
(Zone
).Field3
;
799 end First_Comment_Before_End
;
801 -------------------------------
802 -- First_Declarative_Item_Of --
803 -------------------------------
805 function First_Declarative_Item_Of
806 (Node
: Project_Node_Id
;
807 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
813 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
815 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
817 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
819 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
then
820 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
822 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
824 end First_Declarative_Item_Of
;
826 ------------------------------
827 -- First_Expression_In_List --
828 ------------------------------
830 function First_Expression_In_List
831 (Node
: Project_Node_Id
;
832 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
838 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String_List
);
839 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
840 end First_Expression_In_List
;
842 --------------------------
843 -- First_Literal_String --
844 --------------------------
846 function First_Literal_String
847 (Node
: Project_Node_Id
;
848 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
854 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
855 N_String_Type_Declaration
);
856 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
857 end First_Literal_String
;
859 ----------------------
860 -- First_Package_Of --
861 ----------------------
863 function First_Package_Of
864 (Node
: Project_Node_Id
;
865 In_Tree
: Project_Node_Tree_Ref
) return Package_Declaration_Id
871 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
872 return In_Tree
.Project_Nodes
.Table
(Node
).Packages
;
873 end First_Package_Of
;
875 --------------------------
876 -- First_String_Type_Of --
877 --------------------------
879 function First_String_Type_Of
880 (Node
: Project_Node_Id
;
881 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
887 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
888 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
889 end First_String_Type_Of
;
896 (Node
: Project_Node_Id
;
897 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
903 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
904 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
907 -----------------------
908 -- First_Variable_Of --
909 -----------------------
911 function First_Variable_Of
912 (Node
: Project_Node_Id
;
913 In_Tree
: Project_Node_Tree_Ref
) return Variable_Node_Id
919 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
921 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
923 return In_Tree
.Project_Nodes
.Table
(Node
).Variables
;
924 end First_Variable_Of
;
926 --------------------------
927 -- First_With_Clause_Of --
928 --------------------------
930 function First_With_Clause_Of
931 (Node
: Project_Node_Id
;
932 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
938 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
939 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
940 end First_With_Clause_Of
;
942 ------------------------
943 -- Follows_Empty_Line --
944 ------------------------
946 function Follows_Empty_Line
947 (Node
: Project_Node_Id
;
948 In_Tree
: Project_Node_Tree_Ref
) return Boolean is
953 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
954 return In_Tree
.Project_Nodes
.Table
(Node
).Flag1
;
955 end Follows_Empty_Line
;
961 function Hash
(N
: Project_Node_Id
) return Header_Num
is
963 return Header_Num
(N
mod Project_Node_Id
(Header_Num
'Last));
970 procedure Initialize
(Tree
: Project_Node_Tree_Ref
) is
972 Project_Node_Table
.Init
(Tree
.Project_Nodes
);
973 Projects_Htable
.Reset
(Tree
.Projects_HT
);
976 -------------------------------
977 -- Is_Followed_By_Empty_Line --
978 -------------------------------
980 function Is_Followed_By_Empty_Line
981 (Node
: Project_Node_Id
;
982 In_Tree
: Project_Node_Tree_Ref
) return Boolean
988 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
989 return In_Tree
.Project_Nodes
.Table
(Node
).Flag2
;
990 end Is_Followed_By_Empty_Line
;
992 ----------------------
993 -- Is_Extending_All --
994 ----------------------
996 function Is_Extending_All
997 (Node
: Project_Node_Id
;
998 In_Tree
: Project_Node_Tree_Ref
) return Boolean is
1003 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
1005 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1006 return In_Tree
.Project_Nodes
.Table
(Node
).Flag2
;
1007 end Is_Extending_All
;
1009 -------------------------
1010 -- Is_Not_Last_In_List --
1011 -------------------------
1013 function Is_Not_Last_In_List
1014 (Node
: Project_Node_Id
;
1015 In_Tree
: Project_Node_Tree_Ref
) return Boolean is
1020 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
1021 return In_Tree
.Project_Nodes
.Table
(Node
).Flag1
;
1022 end Is_Not_Last_In_List
;
1024 -------------------------------------
1025 -- Imported_Or_Extended_Project_Of --
1026 -------------------------------------
1028 function Imported_Or_Extended_Project_Of
1029 (Project
: Project_Node_Id
;
1030 In_Tree
: Project_Node_Tree_Ref
;
1031 With_Name
: Name_Id
) return Project_Node_Id
1033 With_Clause
: Project_Node_Id
:=
1034 First_With_Clause_Of
(Project
, In_Tree
);
1035 Result
: Project_Node_Id
:= Empty_Node
;
1038 -- First check all the imported projects
1040 while With_Clause
/= Empty_Node
loop
1042 -- Only non limited imported project may be used as prefix
1043 -- of variable or attributes.
1045 Result
:= Non_Limited_Project_Node_Of
(With_Clause
, In_Tree
);
1046 exit when Result
/= Empty_Node
1047 and then Name_Of
(Result
, In_Tree
) = With_Name
;
1048 With_Clause
:= Next_With_Clause_Of
(With_Clause
, In_Tree
);
1051 -- If it is not an imported project, it might be the imported project
1053 if With_Clause
= Empty_Node
then
1056 (Project_Declaration_Of
(Project
, In_Tree
), In_Tree
);
1058 if Result
/= Empty_Node
1059 and then Name_Of
(Result
, In_Tree
) /= With_Name
1061 Result
:= Empty_Node
;
1066 end Imported_Or_Extended_Project_Of
;
1073 (Node
: Project_Node_Id
;
1074 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Kind
is
1076 pragma Assert
(Node
/= Empty_Node
);
1077 return In_Tree
.Project_Nodes
.Table
(Node
).Kind
;
1084 function Location_Of
1085 (Node
: Project_Node_Id
;
1086 In_Tree
: Project_Node_Tree_Ref
) return Source_Ptr
is
1088 pragma Assert
(Node
/= Empty_Node
);
1089 return In_Tree
.Project_Nodes
.Table
(Node
).Location
;
1097 (Node
: Project_Node_Id
;
1098 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
is
1100 pragma Assert
(Node
/= Empty_Node
);
1101 return In_Tree
.Project_Nodes
.Table
(Node
).Name
;
1104 --------------------
1105 -- Next_Case_Item --
1106 --------------------
1108 function Next_Case_Item
1109 (Node
: Project_Node_Id
;
1110 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1116 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
1117 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1124 function Next_Comment
1125 (Node
: Project_Node_Id
;
1126 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
is
1131 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
1132 return In_Tree
.Project_Nodes
.Table
(Node
).Comments
;
1135 ---------------------------
1136 -- Next_Declarative_Item --
1137 ---------------------------
1139 function Next_Declarative_Item
1140 (Node
: Project_Node_Id
;
1141 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1147 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
1148 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1149 end Next_Declarative_Item
;
1151 -----------------------------
1152 -- Next_Expression_In_List --
1153 -----------------------------
1155 function Next_Expression_In_List
1156 (Node
: Project_Node_Id
;
1157 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1163 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
1164 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1165 end Next_Expression_In_List
;
1167 -------------------------
1168 -- Next_Literal_String --
1169 -------------------------
1171 function Next_Literal_String
1172 (Node
: Project_Node_Id
;
1173 In_Tree
: Project_Node_Tree_Ref
)
1174 return Project_Node_Id
1180 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
);
1181 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
1182 end Next_Literal_String
;
1184 -----------------------------
1185 -- Next_Package_In_Project --
1186 -----------------------------
1188 function Next_Package_In_Project
1189 (Node
: Project_Node_Id
;
1190 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1196 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1197 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1198 end Next_Package_In_Project
;
1200 ----------------------
1201 -- Next_String_Type --
1202 ----------------------
1204 function Next_String_Type
1205 (Node
: Project_Node_Id
;
1206 In_Tree
: Project_Node_Tree_Ref
)
1207 return Project_Node_Id
1213 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1214 N_String_Type_Declaration
);
1215 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1216 end Next_String_Type
;
1223 (Node
: Project_Node_Id
;
1224 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1230 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
);
1231 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1238 function Next_Variable
1239 (Node
: Project_Node_Id
;
1240 In_Tree
: Project_Node_Tree_Ref
)
1241 return Project_Node_Id
1247 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1248 N_Typed_Variable_Declaration
1250 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1251 N_Variable_Declaration
));
1253 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1256 -------------------------
1257 -- Next_With_Clause_Of --
1258 -------------------------
1260 function Next_With_Clause_Of
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_With_Clause
);
1269 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1270 end Next_With_Clause_Of
;
1272 ---------------------------------
1273 -- Non_Limited_Project_Node_Of --
1274 ---------------------------------
1276 function Non_Limited_Project_Node_Of
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_With_Clause
));
1285 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
1286 end Non_Limited_Project_Node_Of
;
1292 function Package_Id_Of
1293 (Node
: Project_Node_Id
;
1294 In_Tree
: Project_Node_Tree_Ref
) return Package_Node_Id
1300 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1301 return In_Tree
.Project_Nodes
.Table
(Node
).Pkg_Id
;
1304 ---------------------
1305 -- Package_Node_Of --
1306 ---------------------
1308 function Package_Node_Of
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_Variable_Reference
1318 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1319 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1320 end Package_Node_Of
;
1326 function Path_Name_Of
1327 (Node
: Project_Node_Id
;
1328 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
1334 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
1336 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1337 return In_Tree
.Project_Nodes
.Table
(Node
).Path_Name
;
1340 ----------------------------
1341 -- Project_Declaration_Of --
1342 ----------------------------
1344 function Project_Declaration_Of
1345 (Node
: Project_Node_Id
;
1346 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1352 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1353 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
1354 end Project_Declaration_Of
;
1356 -------------------------------------------
1357 -- Project_File_Includes_Unkept_Comments --
1358 -------------------------------------------
1360 function Project_File_Includes_Unkept_Comments
1361 (Node
: Project_Node_Id
;
1362 In_Tree
: Project_Node_Tree_Ref
) return Boolean
1364 Declaration
: constant Project_Node_Id
:=
1365 Project_Declaration_Of
(Node
, In_Tree
);
1367 return In_Tree
.Project_Nodes
.Table
(Declaration
).Flag1
;
1368 end Project_File_Includes_Unkept_Comments
;
1370 ---------------------
1371 -- Project_Node_Of --
1372 ---------------------
1374 function Project_Node_Of
1375 (Node
: Project_Node_Id
;
1376 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1382 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
1384 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1386 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1387 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
1388 end Project_Node_Of
;
1390 -----------------------------------
1391 -- Project_Of_Renamed_Package_Of --
1392 -----------------------------------
1394 function Project_Of_Renamed_Package_Of
1395 (Node
: Project_Node_Id
;
1396 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
1402 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1403 return In_Tree
.Project_Nodes
.Table
(Node
).Field1
;
1404 end Project_Of_Renamed_Package_Of
;
1406 --------------------------
1407 -- Remove_Next_End_Node --
1408 --------------------------
1410 procedure Remove_Next_End_Node
is
1412 Next_End_Nodes
.Decrement_Last
;
1413 end Remove_Next_End_Node
;
1419 procedure Reset_State
is
1421 End_Of_Line_Node
:= Empty_Node
;
1422 Previous_Line_Node
:= Empty_Node
;
1423 Previous_End_Node
:= Empty_Node
;
1424 Unkept_Comments
:= False;
1425 Comments
.Set_Last
(0);
1432 procedure Restore
(S
: in Comment_State
) is
1434 End_Of_Line_Node
:= S
.End_Of_Line_Node
;
1435 Previous_Line_Node
:= S
.Previous_Line_Node
;
1436 Previous_End_Node
:= S
.Previous_End_Node
;
1437 Next_End_Nodes
.Set_Last
(0);
1438 Unkept_Comments
:= S
.Unkept_Comments
;
1440 Comments
.Set_Last
(0);
1442 for J
in S
.Comments
'Range loop
1443 Comments
.Increment_Last
;
1444 Comments
.Table
(Comments
.Last
) := S
.Comments
(J
);
1452 procedure Save
(S
: out Comment_State
) is
1453 Cmts
: constant Comments_Ptr
:= new Comment_Array
(1 .. Comments
.Last
);
1456 for J
in 1 .. Comments
.Last
loop
1457 Cmts
(J
) := Comments
.Table
(J
);
1461 (End_Of_Line_Node
=> End_Of_Line_Node
,
1462 Previous_Line_Node
=> Previous_Line_Node
,
1463 Previous_End_Node
=> Previous_End_Node
,
1464 Unkept_Comments
=> Unkept_Comments
,
1472 procedure Scan
(In_Tree
: Project_Node_Tree_Ref
) is
1473 Empty_Line
: Boolean := False;
1476 -- If there are comments, then they will not be kept. Set the flag and
1477 -- clear the comments.
1479 if Comments
.Last
> 0 then
1480 Unkept_Comments
:= True;
1481 Comments
.Set_Last
(0);
1484 -- Loop until a token other that End_Of_Line or Comment is found
1487 Prj
.Err
.Scanner
.Scan
;
1490 when Tok_End_Of_Line
=>
1491 if Prev_Token
= Tok_End_Of_Line
then
1494 if Comments
.Last
> 0 then
1495 Comments
.Table
(Comments
.Last
).Is_Followed_By_Empty_Line
1501 -- If this is a line comment, add it to the comment table
1503 if Prev_Token
= Tok_End_Of_Line
1504 or else Prev_Token
= No_Token
1506 Comments
.Increment_Last
;
1507 Comments
.Table
(Comments
.Last
) :=
1508 (Value
=> Comment_Id
,
1509 Follows_Empty_Line
=> Empty_Line
,
1510 Is_Followed_By_Empty_Line
=> False);
1512 -- Otherwise, it is an end of line comment. If there is
1513 -- an end of line node specified, associate the comment with
1516 elsif End_Of_Line_Node
/= Empty_Node
then
1518 Zones
: constant Project_Node_Id
:=
1519 Comment_Zones_Of
(End_Of_Line_Node
, In_Tree
);
1521 In_Tree
.Project_Nodes
.Table
(Zones
).Value
:= Comment_Id
;
1524 -- Otherwise, this end of line node cannot be kept
1527 Unkept_Comments
:= True;
1528 Comments
.Set_Last
(0);
1531 Empty_Line
:= False;
1534 -- If there are comments, where the first comment is not
1535 -- following an empty line, put the initial uninterrupted
1536 -- comment zone with the node of the preceding line (either
1537 -- a Previous_Line or a Previous_End node), if any.
1539 if Comments
.Last
> 0 and then
1540 not Comments
.Table
(1).Follows_Empty_Line
then
1541 if Previous_Line_Node
/= Empty_Node
then
1543 (To
=> Previous_Line_Node
,
1545 In_Tree
=> In_Tree
);
1547 elsif Previous_End_Node
/= Empty_Node
then
1549 (To
=> Previous_End_Node
,
1551 In_Tree
=> In_Tree
);
1555 -- If there are still comments and the token is "end", then
1556 -- put these comments with the Next_End node, if any;
1557 -- otherwise, these comments cannot be kept. Always clear
1560 if Comments
.Last
> 0 and then Token
= Tok_End
then
1561 if Next_End_Nodes
.Last
> 0 then
1563 (To
=> Next_End_Nodes
.Table
(Next_End_Nodes
.Last
),
1564 Where
=> Before_End
,
1565 In_Tree
=> In_Tree
);
1568 Unkept_Comments
:= True;
1571 Comments
.Set_Last
(0);
1574 -- Reset the End_Of_Line, Previous_Line and Previous_End nodes
1575 -- so that they are not used again.
1577 End_Of_Line_Node
:= Empty_Node
;
1578 Previous_Line_Node
:= Empty_Node
;
1579 Previous_End_Node
:= Empty_Node
;
1588 ------------------------------------
1589 -- Set_Associative_Array_Index_Of --
1590 ------------------------------------
1592 procedure Set_Associative_Array_Index_Of
1593 (Node
: Project_Node_Id
;
1594 In_Tree
: Project_Node_Tree_Ref
;
1601 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1603 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1604 In_Tree
.Project_Nodes
.Table
(Node
).Value
:= To
;
1605 end Set_Associative_Array_Index_Of
;
1607 --------------------------------
1608 -- Set_Associative_Package_Of --
1609 --------------------------------
1611 procedure Set_Associative_Package_Of
1612 (Node
: Project_Node_Id
;
1613 In_Tree
: Project_Node_Tree_Ref
;
1614 To
: Project_Node_Id
)
1620 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
);
1621 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
1622 end Set_Associative_Package_Of
;
1624 --------------------------------
1625 -- Set_Associative_Project_Of --
1626 --------------------------------
1628 procedure Set_Associative_Project_Of
1629 (Node
: Project_Node_Id
;
1630 In_Tree
: Project_Node_Tree_Ref
;
1631 To
: Project_Node_Id
)
1637 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1638 N_Attribute_Declaration
));
1639 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
1640 end Set_Associative_Project_Of
;
1642 --------------------------
1643 -- Set_Case_Insensitive --
1644 --------------------------
1646 procedure Set_Case_Insensitive
1647 (Node
: Project_Node_Id
;
1648 In_Tree
: Project_Node_Tree_Ref
;
1655 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1657 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1658 In_Tree
.Project_Nodes
.Table
(Node
).Flag1
:= To
;
1659 end Set_Case_Insensitive
;
1661 ------------------------------------
1662 -- Set_Case_Variable_Reference_Of --
1663 ------------------------------------
1665 procedure Set_Case_Variable_Reference_Of
1666 (Node
: Project_Node_Id
;
1667 In_Tree
: Project_Node_Tree_Ref
;
1668 To
: Project_Node_Id
)
1674 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
1675 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1676 end Set_Case_Variable_Reference_Of
;
1678 ---------------------------
1679 -- Set_Current_Item_Node --
1680 ---------------------------
1682 procedure Set_Current_Item_Node
1683 (Node
: Project_Node_Id
;
1684 In_Tree
: Project_Node_Tree_Ref
;
1685 To
: Project_Node_Id
)
1691 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
1692 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1693 end Set_Current_Item_Node
;
1695 ----------------------
1696 -- Set_Current_Term --
1697 ----------------------
1699 procedure Set_Current_Term
1700 (Node
: Project_Node_Id
;
1701 In_Tree
: Project_Node_Tree_Ref
;
1702 To
: Project_Node_Id
)
1708 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
);
1709 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1710 end Set_Current_Term
;
1712 ----------------------
1713 -- Set_Directory_Of --
1714 ----------------------
1716 procedure Set_Directory_Of
1717 (Node
: Project_Node_Id
;
1718 In_Tree
: Project_Node_Tree_Ref
;
1725 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1726 In_Tree
.Project_Nodes
.Table
(Node
).Directory
:= To
;
1727 end Set_Directory_Of
;
1729 ---------------------
1730 -- Set_End_Of_Line --
1731 ---------------------
1733 procedure Set_End_Of_Line
(To
: Project_Node_Id
) is
1735 End_Of_Line_Node
:= To
;
1736 end Set_End_Of_Line
;
1738 ----------------------------
1739 -- Set_Expression_Kind_Of --
1740 ----------------------------
1742 procedure Set_Expression_Kind_Of
1743 (Node
: Project_Node_Id
;
1744 In_Tree
: Project_Node_Tree_Ref
;
1751 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
1753 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1755 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
1757 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1758 N_Typed_Variable_Declaration
1760 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
1762 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
1764 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
1766 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1768 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1769 N_Attribute_Reference
));
1770 In_Tree
.Project_Nodes
.Table
(Node
).Expr_Kind
:= To
;
1771 end Set_Expression_Kind_Of
;
1773 -----------------------
1774 -- Set_Expression_Of --
1775 -----------------------
1777 procedure Set_Expression_Of
1778 (Node
: Project_Node_Id
;
1779 In_Tree
: Project_Node_Tree_Ref
;
1780 To
: Project_Node_Id
)
1786 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1787 N_Attribute_Declaration
1789 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1790 N_Typed_Variable_Declaration
1792 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
1793 N_Variable_Declaration
));
1794 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1795 end Set_Expression_Of
;
1797 -------------------------------
1798 -- Set_External_Reference_Of --
1799 -------------------------------
1801 procedure Set_External_Reference_Of
1802 (Node
: Project_Node_Id
;
1803 In_Tree
: Project_Node_Tree_Ref
;
1804 To
: Project_Node_Id
)
1810 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
1811 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1812 end Set_External_Reference_Of
;
1814 -----------------------------
1815 -- Set_External_Default_Of --
1816 -----------------------------
1818 procedure Set_External_Default_Of
1819 (Node
: Project_Node_Id
;
1820 In_Tree
: Project_Node_Tree_Ref
;
1821 To
: Project_Node_Id
)
1827 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
1828 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
1829 end Set_External_Default_Of
;
1831 ----------------------------
1832 -- Set_First_Case_Item_Of --
1833 ----------------------------
1835 procedure Set_First_Case_Item_Of
1836 (Node
: Project_Node_Id
;
1837 In_Tree
: Project_Node_Tree_Ref
;
1838 To
: Project_Node_Id
)
1844 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
1845 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
1846 end Set_First_Case_Item_Of
;
1848 -------------------------
1849 -- Set_First_Choice_Of --
1850 -------------------------
1852 procedure Set_First_Choice_Of
1853 (Node
: Project_Node_Id
;
1854 In_Tree
: Project_Node_Tree_Ref
;
1855 To
: Project_Node_Id
)
1861 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
1862 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1863 end Set_First_Choice_Of
;
1865 -----------------------------
1866 -- Set_First_Comment_After --
1867 -----------------------------
1869 procedure Set_First_Comment_After
1870 (Node
: Project_Node_Id
;
1871 In_Tree
: Project_Node_Tree_Ref
;
1872 To
: Project_Node_Id
)
1874 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
1876 In_Tree
.Project_Nodes
.Table
(Zone
).Field2
:= To
;
1877 end Set_First_Comment_After
;
1879 ---------------------------------
1880 -- Set_First_Comment_After_End --
1881 ---------------------------------
1883 procedure Set_First_Comment_After_End
1884 (Node
: Project_Node_Id
;
1885 In_Tree
: Project_Node_Tree_Ref
;
1886 To
: Project_Node_Id
)
1888 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
1890 In_Tree
.Project_Nodes
.Table
(Zone
).Comments
:= To
;
1891 end Set_First_Comment_After_End
;
1893 ------------------------------
1894 -- Set_First_Comment_Before --
1895 ------------------------------
1897 procedure Set_First_Comment_Before
1898 (Node
: Project_Node_Id
;
1899 In_Tree
: Project_Node_Tree_Ref
;
1900 To
: Project_Node_Id
)
1903 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
1905 In_Tree
.Project_Nodes
.Table
(Zone
).Field1
:= To
;
1906 end Set_First_Comment_Before
;
1908 ----------------------------------
1909 -- Set_First_Comment_Before_End --
1910 ----------------------------------
1912 procedure Set_First_Comment_Before_End
1913 (Node
: Project_Node_Id
;
1914 In_Tree
: Project_Node_Tree_Ref
;
1915 To
: Project_Node_Id
)
1917 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
, In_Tree
);
1919 In_Tree
.Project_Nodes
.Table
(Zone
).Field2
:= To
;
1920 end Set_First_Comment_Before_End
;
1922 ------------------------
1923 -- Set_Next_Case_Item --
1924 ------------------------
1926 procedure Set_Next_Case_Item
1927 (Node
: Project_Node_Id
;
1928 In_Tree
: Project_Node_Tree_Ref
;
1929 To
: Project_Node_Id
)
1935 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
1936 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
1937 end Set_Next_Case_Item
;
1939 ----------------------
1940 -- Set_Next_Comment --
1941 ----------------------
1943 procedure Set_Next_Comment
1944 (Node
: Project_Node_Id
;
1945 In_Tree
: Project_Node_Tree_Ref
;
1946 To
: Project_Node_Id
)
1952 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
1953 In_Tree
.Project_Nodes
.Table
(Node
).Comments
:= To
;
1954 end Set_Next_Comment
;
1956 -----------------------------------
1957 -- Set_First_Declarative_Item_Of --
1958 -----------------------------------
1960 procedure Set_First_Declarative_Item_Of
1961 (Node
: Project_Node_Id
;
1962 In_Tree
: Project_Node_Tree_Ref
;
1963 To
: Project_Node_Id
)
1969 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
1971 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
1973 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
1975 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
then
1976 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1978 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
1980 end Set_First_Declarative_Item_Of
;
1982 ----------------------------------
1983 -- Set_First_Expression_In_List --
1984 ----------------------------------
1986 procedure Set_First_Expression_In_List
1987 (Node
: Project_Node_Id
;
1988 In_Tree
: Project_Node_Tree_Ref
;
1989 To
: Project_Node_Id
)
1995 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String_List
);
1996 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
1997 end Set_First_Expression_In_List
;
1999 ------------------------------
2000 -- Set_First_Literal_String --
2001 ------------------------------
2003 procedure Set_First_Literal_String
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_String_Type_Declaration
);
2014 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2015 end Set_First_Literal_String
;
2017 --------------------------
2018 -- Set_First_Package_Of --
2019 --------------------------
2021 procedure Set_First_Package_Of
2022 (Node
: Project_Node_Id
;
2023 In_Tree
: Project_Node_Tree_Ref
;
2024 To
: Package_Declaration_Id
)
2030 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2031 In_Tree
.Project_Nodes
.Table
(Node
).Packages
:= To
;
2032 end Set_First_Package_Of
;
2034 ------------------------------
2035 -- Set_First_String_Type_Of --
2036 ------------------------------
2038 procedure Set_First_String_Type_Of
2039 (Node
: Project_Node_Id
;
2040 In_Tree
: Project_Node_Tree_Ref
;
2041 To
: Project_Node_Id
)
2047 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2048 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2049 end Set_First_String_Type_Of
;
2051 --------------------
2052 -- Set_First_Term --
2053 --------------------
2055 procedure Set_First_Term
2056 (Node
: Project_Node_Id
;
2057 In_Tree
: Project_Node_Tree_Ref
;
2058 To
: Project_Node_Id
)
2064 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
2065 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2068 ---------------------------
2069 -- Set_First_Variable_Of --
2070 ---------------------------
2072 procedure Set_First_Variable_Of
2073 (Node
: Project_Node_Id
;
2074 In_Tree
: Project_Node_Tree_Ref
;
2075 To
: Variable_Node_Id
)
2081 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
2083 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
2084 In_Tree
.Project_Nodes
.Table
(Node
).Variables
:= To
;
2085 end Set_First_Variable_Of
;
2087 ------------------------------
2088 -- Set_First_With_Clause_Of --
2089 ------------------------------
2091 procedure Set_First_With_Clause_Of
2092 (Node
: Project_Node_Id
;
2093 In_Tree
: Project_Node_Tree_Ref
;
2094 To
: Project_Node_Id
)
2100 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2101 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2102 end Set_First_With_Clause_Of
;
2104 --------------------------
2105 -- Set_Is_Extending_All --
2106 --------------------------
2108 procedure Set_Is_Extending_All
2109 (Node
: Project_Node_Id
;
2110 In_Tree
: Project_Node_Tree_Ref
)
2116 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
2118 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
2119 In_Tree
.Project_Nodes
.Table
(Node
).Flag2
:= True;
2120 end Set_Is_Extending_All
;
2122 -----------------------------
2123 -- Set_Is_Not_Last_In_List --
2124 -----------------------------
2126 procedure Set_Is_Not_Last_In_List
2127 (Node
: Project_Node_Id
;
2128 In_Tree
: Project_Node_Tree_Ref
)
2134 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
2135 In_Tree
.Project_Nodes
.Table
(Node
).Flag1
:= True;
2136 end Set_Is_Not_Last_In_List
;
2142 procedure Set_Kind_Of
2143 (Node
: Project_Node_Id
;
2144 In_Tree
: Project_Node_Tree_Ref
;
2145 To
: Project_Node_Kind
)
2148 pragma Assert
(Node
/= Empty_Node
);
2149 In_Tree
.Project_Nodes
.Table
(Node
).Kind
:= To
;
2152 ---------------------
2153 -- Set_Location_Of --
2154 ---------------------
2156 procedure Set_Location_Of
2157 (Node
: Project_Node_Id
;
2158 In_Tree
: Project_Node_Tree_Ref
;
2162 pragma Assert
(Node
/= Empty_Node
);
2163 In_Tree
.Project_Nodes
.Table
(Node
).Location
:= To
;
2164 end Set_Location_Of
;
2166 -----------------------------
2167 -- Set_Extended_Project_Of --
2168 -----------------------------
2170 procedure Set_Extended_Project_Of
2171 (Node
: Project_Node_Id
;
2172 In_Tree
: Project_Node_Tree_Ref
;
2173 To
: Project_Node_Id
)
2179 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
2180 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2181 end Set_Extended_Project_Of
;
2183 ----------------------------------
2184 -- Set_Extended_Project_Path_Of --
2185 ----------------------------------
2187 procedure Set_Extended_Project_Path_Of
2188 (Node
: Project_Node_Id
;
2189 In_Tree
: Project_Node_Tree_Ref
;
2196 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2197 In_Tree
.Project_Nodes
.Table
(Node
).Value
:= To
;
2198 end Set_Extended_Project_Path_Of
;
2200 ------------------------------
2201 -- Set_Extending_Project_Of --
2202 ------------------------------
2204 procedure Set_Extending_Project_Of
2205 (Node
: Project_Node_Id
;
2206 In_Tree
: Project_Node_Tree_Ref
;
2207 To
: Project_Node_Id
)
2213 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
2214 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2215 end Set_Extending_Project_Of
;
2221 procedure Set_Name_Of
2222 (Node
: Project_Node_Id
;
2223 In_Tree
: Project_Node_Tree_Ref
;
2227 pragma Assert
(Node
/= Empty_Node
);
2228 In_Tree
.Project_Nodes
.Table
(Node
).Name
:= To
;
2231 -------------------------------
2232 -- Set_Next_Declarative_Item --
2233 -------------------------------
2235 procedure Set_Next_Declarative_Item
2236 (Node
: Project_Node_Id
;
2237 In_Tree
: Project_Node_Tree_Ref
;
2238 To
: Project_Node_Id
)
2244 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
2245 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2246 end Set_Next_Declarative_Item
;
2248 -----------------------
2249 -- Set_Next_End_Node --
2250 -----------------------
2252 procedure Set_Next_End_Node
(To
: Project_Node_Id
) is
2254 Next_End_Nodes
.Increment_Last
;
2255 Next_End_Nodes
.Table
(Next_End_Nodes
.Last
) := To
;
2256 end Set_Next_End_Node
;
2258 ---------------------------------
2259 -- Set_Next_Expression_In_List --
2260 ---------------------------------
2262 procedure Set_Next_Expression_In_List
2263 (Node
: Project_Node_Id
;
2264 In_Tree
: Project_Node_Tree_Ref
;
2265 To
: Project_Node_Id
)
2271 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
2272 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2273 end Set_Next_Expression_In_List
;
2275 -----------------------------
2276 -- Set_Next_Literal_String --
2277 -----------------------------
2279 procedure Set_Next_Literal_String
2280 (Node
: Project_Node_Id
;
2281 In_Tree
: Project_Node_Tree_Ref
;
2282 To
: Project_Node_Id
)
2288 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
);
2289 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2290 end Set_Next_Literal_String
;
2292 ---------------------------------
2293 -- Set_Next_Package_In_Project --
2294 ---------------------------------
2296 procedure Set_Next_Package_In_Project
2297 (Node
: Project_Node_Id
;
2298 In_Tree
: Project_Node_Tree_Ref
;
2299 To
: Project_Node_Id
)
2305 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2306 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2307 end Set_Next_Package_In_Project
;
2309 --------------------------
2310 -- Set_Next_String_Type --
2311 --------------------------
2313 procedure Set_Next_String_Type
2314 (Node
: Project_Node_Id
;
2315 In_Tree
: Project_Node_Tree_Ref
;
2316 To
: Project_Node_Id
)
2322 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2323 N_String_Type_Declaration
);
2324 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2325 end Set_Next_String_Type
;
2331 procedure Set_Next_Term
2332 (Node
: Project_Node_Id
;
2333 In_Tree
: Project_Node_Tree_Ref
;
2334 To
: Project_Node_Id
)
2340 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Term
);
2341 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2344 -----------------------
2345 -- Set_Next_Variable --
2346 -----------------------
2348 procedure Set_Next_Variable
2349 (Node
: Project_Node_Id
;
2350 In_Tree
: Project_Node_Tree_Ref
;
2351 To
: Project_Node_Id
)
2357 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2358 N_Typed_Variable_Declaration
2360 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2361 N_Variable_Declaration
));
2362 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2363 end Set_Next_Variable
;
2365 -----------------------------
2366 -- Set_Next_With_Clause_Of --
2367 -----------------------------
2369 procedure Set_Next_With_Clause_Of
2370 (Node
: Project_Node_Id
;
2371 In_Tree
: Project_Node_Tree_Ref
;
2372 To
: Project_Node_Id
)
2378 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
2379 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2380 end Set_Next_With_Clause_Of
;
2382 -----------------------
2383 -- Set_Package_Id_Of --
2384 -----------------------
2386 procedure Set_Package_Id_Of
2387 (Node
: Project_Node_Id
;
2388 In_Tree
: Project_Node_Tree_Ref
;
2389 To
: Package_Node_Id
)
2395 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2396 In_Tree
.Project_Nodes
.Table
(Node
).Pkg_Id
:= To
;
2397 end Set_Package_Id_Of
;
2399 -------------------------
2400 -- Set_Package_Node_Of --
2401 -------------------------
2403 procedure Set_Package_Node_Of
2404 (Node
: Project_Node_Id
;
2405 In_Tree
: Project_Node_Tree_Ref
;
2406 To
: Project_Node_Id
)
2412 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2414 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
2415 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2416 end Set_Package_Node_Of
;
2418 ----------------------
2419 -- Set_Path_Name_Of --
2420 ----------------------
2422 procedure Set_Path_Name_Of
2423 (Node
: Project_Node_Id
;
2424 In_Tree
: Project_Node_Tree_Ref
;
2431 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
2433 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
2434 In_Tree
.Project_Nodes
.Table
(Node
).Path_Name
:= To
;
2435 end Set_Path_Name_Of
;
2437 ---------------------------
2438 -- Set_Previous_End_Node --
2439 ---------------------------
2440 procedure Set_Previous_End_Node
(To
: Project_Node_Id
) is
2442 Previous_End_Node
:= To
;
2443 end Set_Previous_End_Node
;
2445 ----------------------------
2446 -- Set_Previous_Line_Node --
2447 ----------------------------
2449 procedure Set_Previous_Line_Node
(To
: Project_Node_Id
) is
2451 Previous_Line_Node
:= To
;
2452 end Set_Previous_Line_Node
;
2454 --------------------------------
2455 -- Set_Project_Declaration_Of --
2456 --------------------------------
2458 procedure Set_Project_Declaration_Of
2459 (Node
: Project_Node_Id
;
2460 In_Tree
: Project_Node_Tree_Ref
;
2461 To
: Project_Node_Id
)
2467 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2468 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2469 end Set_Project_Declaration_Of
;
2471 -----------------------------------------------
2472 -- Set_Project_File_Includes_Unkept_Comments --
2473 -----------------------------------------------
2475 procedure Set_Project_File_Includes_Unkept_Comments
2476 (Node
: Project_Node_Id
;
2477 In_Tree
: Project_Node_Tree_Ref
;
2480 Declaration
: constant Project_Node_Id
:=
2481 Project_Declaration_Of
(Node
, In_Tree
);
2483 In_Tree
.Project_Nodes
.Table
(Declaration
).Flag1
:= To
;
2484 end Set_Project_File_Includes_Unkept_Comments
;
2486 -------------------------
2487 -- Set_Project_Node_Of --
2488 -------------------------
2490 procedure Set_Project_Node_Of
2491 (Node
: Project_Node_Id
;
2492 In_Tree
: Project_Node_Tree_Ref
;
2493 To
: Project_Node_Id
;
2494 Limited_With
: Boolean := False)
2500 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2502 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2504 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
2505 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2507 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2508 and then not Limited_With
2510 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2512 end Set_Project_Node_Of
;
2514 ---------------------------------------
2515 -- Set_Project_Of_Renamed_Package_Of --
2516 ---------------------------------------
2518 procedure Set_Project_Of_Renamed_Package_Of
2519 (Node
: Project_Node_Id
;
2520 In_Tree
: Project_Node_Tree_Ref
;
2521 To
: Project_Node_Id
)
2527 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2528 In_Tree
.Project_Nodes
.Table
(Node
).Field1
:= To
;
2529 end Set_Project_Of_Renamed_Package_Of
;
2531 -------------------------
2532 -- Set_Source_Index_Of --
2533 -------------------------
2535 procedure Set_Source_Index_Of
2536 (Node
: Project_Node_Id
;
2537 In_Tree
: Project_Node_Tree_Ref
;
2544 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
2546 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2547 N_Attribute_Declaration
));
2548 In_Tree
.Project_Nodes
.Table
(Node
).Src_Index
:= To
;
2549 end Set_Source_Index_Of
;
2551 ------------------------
2552 -- Set_String_Type_Of --
2553 ------------------------
2555 procedure Set_String_Type_Of
2556 (Node
: Project_Node_Id
;
2557 In_Tree
: Project_Node_Tree_Ref
;
2558 To
: Project_Node_Id
)
2564 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2565 N_Variable_Reference
2567 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2568 N_Typed_Variable_Declaration
)
2570 In_Tree
.Project_Nodes
.Table
(To
).Kind
= N_String_Type_Declaration
);
2572 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
then
2573 In_Tree
.Project_Nodes
.Table
(Node
).Field3
:= To
;
2575 In_Tree
.Project_Nodes
.Table
(Node
).Field2
:= To
;
2577 end Set_String_Type_Of
;
2579 -------------------------
2580 -- Set_String_Value_Of --
2581 -------------------------
2583 procedure Set_String_Value_Of
2584 (Node
: Project_Node_Id
;
2585 In_Tree
: Project_Node_Tree_Ref
;
2592 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2594 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
2596 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
));
2597 In_Tree
.Project_Nodes
.Table
(Node
).Value
:= To
;
2598 end Set_String_Value_Of
;
2600 ---------------------
2601 -- Source_Index_Of --
2602 ---------------------
2604 function Source_Index_Of
2605 (Node
: Project_Node_Id
;
2606 In_Tree
: Project_Node_Tree_Ref
) return Int
2612 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
2614 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2615 N_Attribute_Declaration
));
2616 return In_Tree
.Project_Nodes
.Table
(Node
).Src_Index
;
2617 end Source_Index_Of
;
2619 --------------------
2620 -- String_Type_Of --
2621 --------------------
2623 function String_Type_Of
2624 (Node
: Project_Node_Id
;
2625 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
2631 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2632 N_Variable_Reference
2634 In_Tree
.Project_Nodes
.Table
(Node
).Kind
=
2635 N_Typed_Variable_Declaration
));
2637 if In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
then
2638 return In_Tree
.Project_Nodes
.Table
(Node
).Field3
;
2640 return In_Tree
.Project_Nodes
.Table
(Node
).Field2
;
2644 ---------------------
2645 -- String_Value_Of --
2646 ---------------------
2648 function String_Value_Of
2649 (Node
: Project_Node_Id
;
2650 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
2656 (In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2658 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Comment
2660 In_Tree
.Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
));
2661 return In_Tree
.Project_Nodes
.Table
(Node
).Value
;
2662 end String_Value_Of
;
2664 --------------------
2665 -- Value_Is_Valid --
2666 --------------------
2668 function Value_Is_Valid
2669 (For_Typed_Variable
: Project_Node_Id
;
2670 In_Tree
: Project_Node_Tree_Ref
;
2671 Value
: Name_Id
) return Boolean
2675 (For_Typed_Variable
/= Empty_Node
2677 (In_Tree
.Project_Nodes
.Table
(For_Typed_Variable
).Kind
=
2678 N_Typed_Variable_Declaration
));
2681 Current_String
: Project_Node_Id
:=
2682 First_Literal_String
2683 (String_Type_Of
(For_Typed_Variable
, In_Tree
),
2687 while Current_String
/= Empty_Node
2689 String_Value_Of
(Current_String
, In_Tree
) /= Value
2692 Next_Literal_String
(Current_String
, In_Tree
);
2695 return Current_String
/= Empty_Node
;
2700 -------------------------------
2701 -- There_Are_Unkept_Comments --
2702 -------------------------------
2704 function There_Are_Unkept_Comments
return Boolean is
2706 return Unkept_Comments
;
2707 end There_Are_Unkept_Comments
;