1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2006, 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 ------------------------------------------------------------------------------
27 -- This package defines the structure of the Project File tree
29 with GNAT
.Dynamic_HTables
;
30 with GNAT
.Dynamic_Tables
;
32 with Prj
.Attr
; use Prj
.Attr
;
36 type Project_Node_Tree_Data
;
37 type Project_Node_Tree_Ref
is access all Project_Node_Tree_Data
;
38 -- Type to designate a project node tree, so that several project node
39 -- trees can coexist in memory.
41 Project_Nodes_Initial
: constant := 1_000
;
42 Project_Nodes_Increment
: constant := 100;
43 -- Allocation parameters for initializing and extending number
44 -- of nodes in table Tree_Private_Part.Project_Nodes
46 Project_Node_Low_Bound
: constant := 0;
47 Project_Node_High_Bound
: constant := 099_999_999
;
48 -- Range of values for project node id's (in practice infinite)
50 type Project_Node_Id
is range
51 Project_Node_Low_Bound
.. Project_Node_High_Bound
;
52 -- The index of table Tree_Private_Part.Project_Nodes
54 Empty_Node
: constant Project_Node_Id
:= Project_Node_Low_Bound
;
55 -- Designates no node in table Project_Nodes
57 First_Node_Id
: constant Project_Node_Id
:= Project_Node_Low_Bound
+ 1;
59 subtype Variable_Node_Id
is Project_Node_Id
;
60 -- Used to designate a node whose expected kind is one of
61 -- N_Typed_Variable_Declaration, N_Variable_Declaration or
62 -- N_Variable_Reference.
64 subtype Package_Declaration_Id
is Project_Node_Id
;
65 -- Used to designate a node whose expected kind is N_Proect_Declaration
67 type Project_Node_Kind
is
70 N_Project_Declaration
,
72 N_Package_Declaration
,
73 N_String_Type_Declaration
,
75 N_Attribute_Declaration
,
76 N_Typed_Variable_Declaration
,
77 N_Variable_Declaration
,
80 N_Literal_String_List
,
83 N_Attribute_Reference
,
88 -- Each node in the tree is of a Project_Node_Kind. For the signification
89 -- of the fields in each node of Project_Node_Kind, look at package
92 procedure Initialize
(Tree
: Project_Node_Tree_Ref
);
93 -- Initialize the Project File tree: empty the Project_Nodes table
94 -- and reset the Projects_Htable.
96 function Default_Project_Node
97 (In_Tree
: Project_Node_Tree_Ref
;
98 Of_Kind
: Project_Node_Kind
;
99 And_Expr_Kind
: Variable_Kind
:= Undefined
) return Project_Node_Id
;
100 -- Returns a Project_Node_Record with the specified Kind and Expr_Kind. All
101 -- the other components have default nil values.
103 function Hash
(N
: Project_Node_Id
) return Header_Num
;
104 -- Used for hash tables where the key is a Project_Node_Id
106 function Imported_Or_Extended_Project_Of
107 (Project
: Project_Node_Id
;
108 In_Tree
: Project_Node_Tree_Ref
;
109 With_Name
: Name_Id
) return Project_Node_Id
;
110 -- Return the node of a project imported or extended by project Project and
111 -- whose name is With_Name. Return Empty_Node if there is no such project.
117 type Comment_State
is private;
118 -- A type to store the values of several global variables related to
121 procedure Save
(S
: out Comment_State
);
122 -- Save in variable S the comment state. Called before scanning a new
125 procedure Restore
(S
: Comment_State
);
126 -- Restore the comment state to a previously saved value. Called after
127 -- scanning a project file.
129 procedure Reset_State
;
130 -- Set the comment state to its initial value. Called before scanning a
133 function There_Are_Unkept_Comments
return Boolean;
134 -- Indicates that some of the comments in a project file could not be
135 -- stored in the parse tree.
137 procedure Set_Previous_Line_Node
(To
: Project_Node_Id
);
138 -- Indicate the node on the previous line. If there are comments
139 -- immediately following this line, then they should be associated with
142 procedure Set_Previous_End_Node
(To
: Project_Node_Id
);
143 -- Indicate that on the previous line the "end" belongs to node To.
144 -- If there are comments immediately following this "end" line, they
145 -- should be associated with this node.
147 procedure Set_End_Of_Line
(To
: Project_Node_Id
);
148 -- Indicate the node on the current line. If there is an end of line
149 -- comment, then it should be associated with this node.
151 procedure Set_Next_End_Node
(To
: Project_Node_Id
);
152 -- Put node To on the top of the end node stack. When an END line is found
153 -- with this node on the top of the end node stack, the comments, if any,
154 -- immediately preceding this "end" line will be associated with this node.
156 procedure Remove_Next_End_Node
;
157 -- Remove the top of the end node stack
159 ------------------------
160 -- Comment Processing --
161 ------------------------
163 type Comment_Data
is record
164 Value
: Name_Id
:= No_Name
;
165 Follows_Empty_Line
: Boolean := False;
166 Is_Followed_By_Empty_Line
: Boolean := False;
168 -- Component type for Comments Table below
170 package Comments
is new Table
.Table
171 (Table_Component_Type
=> Comment_Data
,
172 Table_Index_Type
=> Natural,
173 Table_Low_Bound
=> 1,
175 Table_Increment
=> 100,
176 Table_Name
=> "Prj.Tree.Comments");
177 -- A table to store the comments that may be stored is the tree
179 procedure Scan
(In_Tree
: Project_Node_Tree_Ref
);
180 -- Scan the tokens and accumulate comments
182 type Comment_Location
is
183 (Before
, After
, Before_End
, After_End
, End_Of_Line
);
184 -- Used in call to Add_Comments below
186 procedure Add_Comments
187 (To
: Project_Node_Id
;
188 In_Tree
: Project_Node_Tree_Ref
;
189 Where
: Comment_Location
);
190 -- Add comments to this node
192 ----------------------
193 -- Access Functions --
194 ----------------------
196 -- The following query functions are part of the abstract interface
197 -- of the Project File tree. They provide access to fields of a project.
199 -- In the following, there are "valid if" comments, but no indication
200 -- of what happens if they are called with invalid arguments ???
203 (Node
: Project_Node_Id
;
204 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
205 pragma Inline
(Name_Of
);
206 -- Valid for all non empty nodes. May return No_Name for nodes that have
210 (Node
: Project_Node_Id
;
211 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Kind
;
212 pragma Inline
(Kind_Of
);
213 -- Valid for all non empty nodes
216 (Node
: Project_Node_Id
;
217 In_Tree
: Project_Node_Tree_Ref
) return Source_Ptr
;
218 pragma Inline
(Location_Of
);
219 -- Valid for all non empty nodes
221 function First_Comment_After
222 (Node
: Project_Node_Id
;
223 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
224 -- Valid only for N_Comment_Zones nodes
226 function First_Comment_After_End
227 (Node
: Project_Node_Id
;
228 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
229 -- Valid only for N_Comment_Zones nodes
231 function First_Comment_Before
232 (Node
: Project_Node_Id
;
233 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
234 -- Valid only for N_Comment_Zones nodes
236 function First_Comment_Before_End
237 (Node
: Project_Node_Id
;
238 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
239 -- Valid only for N_Comment_Zones nodes
241 function Next_Comment
242 (Node
: Project_Node_Id
;
243 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
244 -- Valid only for N_Comment nodes
246 function End_Of_Line_Comment
247 (Node
: Project_Node_Id
;
248 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
249 -- Valid only for non empty nodes
251 function Follows_Empty_Line
252 (Node
: Project_Node_Id
;
253 In_Tree
: Project_Node_Tree_Ref
) return Boolean;
254 -- Valid only for N_Comment nodes
256 function Is_Followed_By_Empty_Line
257 (Node
: Project_Node_Id
;
258 In_Tree
: Project_Node_Tree_Ref
) return Boolean;
259 -- Valid only for N_Comment nodes
261 function Project_File_Includes_Unkept_Comments
262 (Node
: Project_Node_Id
;
263 In_Tree
: Project_Node_Tree_Ref
)
265 -- Valid only for N_Project nodes
267 function Directory_Of
268 (Node
: Project_Node_Id
;
269 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
270 pragma Inline
(Directory_Of
);
271 -- Only valid for N_Project nodes
273 function Expression_Kind_Of
274 (Node
: Project_Node_Id
;
275 In_Tree
: Project_Node_Tree_Ref
) return Variable_Kind
;
276 pragma Inline
(Expression_Kind_Of
);
277 -- Only valid for N_Literal_String, N_Attribute_Declaration,
278 -- N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression,
279 -- N_Term, N_Variable_Reference or N_Attribute_Reference nodes.
281 function Is_Extending_All
282 (Node
: Project_Node_Id
;
283 In_Tree
: Project_Node_Tree_Ref
) return Boolean;
284 pragma Inline
(Is_Extending_All
);
285 -- Only valid for N_Project and N_With_Clause
287 function Is_Not_Last_In_List
288 (Node
: Project_Node_Id
;
289 In_Tree
: Project_Node_Tree_Ref
) return Boolean;
290 pragma Inline
(Is_Not_Last_In_List
);
291 -- Only valid for N_With_Clause
293 function First_Variable_Of
294 (Node
: Project_Node_Id
;
295 In_Tree
: Project_Node_Tree_Ref
) return Variable_Node_Id
;
296 pragma Inline
(First_Variable_Of
);
297 -- Only valid for N_Project or N_Package_Declaration nodes
299 function First_Package_Of
300 (Node
: Project_Node_Id
;
301 In_Tree
: Project_Node_Tree_Ref
) return Package_Declaration_Id
;
302 pragma Inline
(First_Package_Of
);
303 -- Only valid for N_Project nodes
305 function Package_Id_Of
306 (Node
: Project_Node_Id
;
307 In_Tree
: Project_Node_Tree_Ref
) return Package_Node_Id
;
308 pragma Inline
(Package_Id_Of
);
309 -- Only valid for N_Package_Declaration nodes
311 function Path_Name_Of
312 (Node
: Project_Node_Id
;
313 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
314 pragma Inline
(Path_Name_Of
);
315 -- Only valid for N_Project and N_With_Clause nodes
317 function String_Value_Of
318 (Node
: Project_Node_Id
;
319 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
320 pragma Inline
(String_Value_Of
);
321 -- Only valid for N_With_Clause, N_Literal_String nodes or N_Comment.
322 -- For a N_With_Clause created automatically for a virtual extending
323 -- project, No_Name is returned.
325 function Source_Index_Of
326 (Node
: Project_Node_Id
;
327 In_Tree
: Project_Node_Tree_Ref
) return Int
;
328 pragma Inline
(Source_Index_Of
);
329 -- Only valid for N_Literal_String and N_Attribute_Declaration nodes
331 function First_With_Clause_Of
332 (Node
: Project_Node_Id
;
333 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
334 pragma Inline
(First_With_Clause_Of
);
335 -- Only valid for N_Project nodes
337 function Project_Declaration_Of
338 (Node
: Project_Node_Id
;
339 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
340 pragma Inline
(Project_Declaration_Of
);
341 -- Only valid for N_Project nodes
343 function Extending_Project_Of
344 (Node
: Project_Node_Id
;
345 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
346 pragma Inline
(Extending_Project_Of
);
347 -- Only valid for N_Project_Declaration nodes
349 function First_String_Type_Of
350 (Node
: Project_Node_Id
;
351 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
352 pragma Inline
(First_String_Type_Of
);
353 -- Only valid for N_Project nodes
355 function Extended_Project_Path_Of
356 (Node
: Project_Node_Id
;
357 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
358 pragma Inline
(Extended_Project_Path_Of
);
359 -- Only valid for N_With_Clause nodes
361 function Project_Node_Of
362 (Node
: Project_Node_Id
;
363 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
364 pragma Inline
(Project_Node_Of
);
365 -- Only valid for N_With_Clause, N_Variable_Reference and
366 -- N_Attribute_Reference nodes.
368 function Non_Limited_Project_Node_Of
369 (Node
: Project_Node_Id
;
370 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
371 pragma Inline
(Non_Limited_Project_Node_Of
);
372 -- Only valid for N_With_Clause nodes. Returns Empty_Node for limited
373 -- imported project files, otherwise returns the same result as
376 function Next_With_Clause_Of
377 (Node
: Project_Node_Id
;
378 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
379 pragma Inline
(Next_With_Clause_Of
);
380 -- Only valid for N_With_Clause nodes
382 function First_Declarative_Item_Of
383 (Node
: Project_Node_Id
;
384 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
385 pragma Inline
(First_Declarative_Item_Of
);
386 -- Only valid for N_With_Clause nodes
388 function Extended_Project_Of
389 (Node
: Project_Node_Id
;
390 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
391 pragma Inline
(Extended_Project_Of
);
392 -- Only valid for N_Project_Declaration nodes
394 function Current_Item_Node
395 (Node
: Project_Node_Id
;
396 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
397 pragma Inline
(Current_Item_Node
);
398 -- Only valid for N_Declarative_Item nodes
400 function Next_Declarative_Item
401 (Node
: Project_Node_Id
;
402 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
403 pragma Inline
(Next_Declarative_Item
);
404 -- Only valid for N_Declarative_Item node
406 function Project_Of_Renamed_Package_Of
407 (Node
: Project_Node_Id
;
408 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
409 pragma Inline
(Project_Of_Renamed_Package_Of
);
410 -- Only valid for N_Package_Declaration nodes.
411 -- May return Empty_Node.
413 function Next_Package_In_Project
414 (Node
: Project_Node_Id
;
415 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
416 pragma Inline
(Next_Package_In_Project
);
417 -- Only valid for N_Package_Declaration nodes
419 function First_Literal_String
420 (Node
: Project_Node_Id
;
421 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
422 pragma Inline
(First_Literal_String
);
423 -- Only valid for N_String_Type_Declaration nodes
425 function Next_String_Type
426 (Node
: Project_Node_Id
;
427 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
428 pragma Inline
(Next_String_Type
);
429 -- Only valid for N_String_Type_Declaration nodes
431 function Next_Literal_String
432 (Node
: Project_Node_Id
;
433 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
434 pragma Inline
(Next_Literal_String
);
435 -- Only valid for N_Literal_String nodes
437 function Expression_Of
438 (Node
: Project_Node_Id
;
439 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
440 pragma Inline
(Expression_Of
);
441 -- Only valid for N_Attribute_Declaration, N_Typed_Variable_Declaration
442 -- or N_Variable_Declaration nodes
444 function Associative_Project_Of
445 (Node
: Project_Node_Id
;
446 In_Tree
: Project_Node_Tree_Ref
)
447 return Project_Node_Id
;
448 pragma Inline
(Associative_Project_Of
);
449 -- Only valid for N_Attribute_Declaration nodes
451 function Associative_Package_Of
452 (Node
: Project_Node_Id
;
453 In_Tree
: Project_Node_Tree_Ref
)
454 return Project_Node_Id
;
455 pragma Inline
(Associative_Package_Of
);
456 -- Only valid for N_Attribute_Declaration nodes
458 function Value_Is_Valid
459 (For_Typed_Variable
: Project_Node_Id
;
460 In_Tree
: Project_Node_Tree_Ref
;
461 Value
: Name_Id
) return Boolean;
462 pragma Inline
(Value_Is_Valid
);
463 -- Only valid for N_Typed_Variable_Declaration. Returns True if Value is
464 -- in the list of allowed strings for For_Typed_Variable. False otherwise.
466 function Associative_Array_Index_Of
467 (Node
: Project_Node_Id
;
468 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
469 pragma Inline
(Associative_Array_Index_Of
);
470 -- Only valid for N_Attribute_Declaration and N_Attribute_Reference.
471 -- Returns No_String for non associative array attributes.
473 function Next_Variable
474 (Node
: Project_Node_Id
;
475 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
476 pragma Inline
(Next_Variable
);
477 -- Only valid for N_Typed_Variable_Declaration or N_Variable_Declaration
481 (Node
: Project_Node_Id
;
482 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
483 pragma Inline
(First_Term
);
484 -- Only valid for N_Expression nodes
486 function Next_Expression_In_List
487 (Node
: Project_Node_Id
;
488 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
489 pragma Inline
(Next_Expression_In_List
);
490 -- Only valid for N_Expression nodes
492 function Current_Term
493 (Node
: Project_Node_Id
;
494 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
495 pragma Inline
(Current_Term
);
496 -- Only valid for N_Term nodes
499 (Node
: Project_Node_Id
;
500 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
501 pragma Inline
(Next_Term
);
502 -- Only valid for N_Term nodes
504 function First_Expression_In_List
505 (Node
: Project_Node_Id
;
506 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
507 pragma Inline
(First_Expression_In_List
);
508 -- Only valid for N_Literal_String_List nodes
510 function Package_Node_Of
511 (Node
: Project_Node_Id
;
512 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
513 pragma Inline
(Package_Node_Of
);
514 -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes.
515 -- May return Empty_Node.
517 function String_Type_Of
518 (Node
: Project_Node_Id
;
519 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
520 pragma Inline
(String_Type_Of
);
521 -- Only valid for N_Variable_Reference or N_Typed_Variable_Declaration
524 function External_Reference_Of
525 (Node
: Project_Node_Id
;
526 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
527 pragma Inline
(External_Reference_Of
);
528 -- Only valid for N_External_Value nodes
530 function External_Default_Of
531 (Node
: Project_Node_Id
;
532 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
533 pragma Inline
(External_Default_Of
);
534 -- Only valid for N_External_Value nodes
536 function Case_Variable_Reference_Of
537 (Node
: Project_Node_Id
;
538 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
539 pragma Inline
(Case_Variable_Reference_Of
);
540 -- Only valid for N_Case_Construction nodes
542 function First_Case_Item_Of
543 (Node
: Project_Node_Id
;
544 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
545 pragma Inline
(First_Case_Item_Of
);
546 -- Only valid for N_Case_Construction nodes
548 function First_Choice_Of
549 (Node
: Project_Node_Id
;
550 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
551 pragma Inline
(First_Choice_Of
);
552 -- Return the first choice in a N_Case_Item, or Empty_Node if
553 -- this is when others.
555 function Next_Case_Item
556 (Node
: Project_Node_Id
;
557 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
558 pragma Inline
(Next_Case_Item
);
559 -- Only valid for N_Case_Item nodes
561 function Case_Insensitive
562 (Node
: Project_Node_Id
;
563 In_Tree
: Project_Node_Tree_Ref
) return Boolean;
564 -- Only valid for N_Attribute_Declaration and N_Attribute_Reference nodes
570 -- The following procedures are part of the abstract interface of
571 -- the Project File tree.
573 -- Each Set_* procedure is valid only for the same Project_Node_Kind
574 -- nodes as the corresponding query function above.
576 procedure Set_Name_Of
577 (Node
: Project_Node_Id
;
578 In_Tree
: Project_Node_Tree_Ref
;
580 pragma Inline
(Set_Name_Of
);
582 procedure Set_Kind_Of
583 (Node
: Project_Node_Id
;
584 In_Tree
: Project_Node_Tree_Ref
;
585 To
: Project_Node_Kind
);
586 pragma Inline
(Set_Kind_Of
);
588 procedure Set_Location_Of
589 (Node
: Project_Node_Id
;
590 In_Tree
: Project_Node_Tree_Ref
;
592 pragma Inline
(Set_Location_Of
);
594 procedure Set_First_Comment_After
595 (Node
: Project_Node_Id
;
596 In_Tree
: Project_Node_Tree_Ref
;
597 To
: Project_Node_Id
);
598 pragma Inline
(Set_First_Comment_After
);
600 procedure Set_First_Comment_After_End
601 (Node
: Project_Node_Id
;
602 In_Tree
: Project_Node_Tree_Ref
;
603 To
: Project_Node_Id
);
604 pragma Inline
(Set_First_Comment_After_End
);
606 procedure Set_First_Comment_Before
607 (Node
: Project_Node_Id
;
608 In_Tree
: Project_Node_Tree_Ref
;
609 To
: Project_Node_Id
);
610 pragma Inline
(Set_First_Comment_Before
);
612 procedure Set_First_Comment_Before_End
613 (Node
: Project_Node_Id
;
614 In_Tree
: Project_Node_Tree_Ref
;
615 To
: Project_Node_Id
);
616 pragma Inline
(Set_First_Comment_Before_End
);
618 procedure Set_Next_Comment
619 (Node
: Project_Node_Id
;
620 In_Tree
: Project_Node_Tree_Ref
;
621 To
: Project_Node_Id
);
622 pragma Inline
(Set_Next_Comment
);
624 procedure Set_Project_File_Includes_Unkept_Comments
625 (Node
: Project_Node_Id
;
626 In_Tree
: Project_Node_Tree_Ref
;
629 procedure Set_Directory_Of
630 (Node
: Project_Node_Id
;
631 In_Tree
: Project_Node_Tree_Ref
;
633 pragma Inline
(Set_Directory_Of
);
635 procedure Set_Expression_Kind_Of
636 (Node
: Project_Node_Id
;
637 In_Tree
: Project_Node_Tree_Ref
;
639 pragma Inline
(Set_Expression_Kind_Of
);
641 procedure Set_Is_Extending_All
642 (Node
: Project_Node_Id
;
643 In_Tree
: Project_Node_Tree_Ref
);
644 pragma Inline
(Set_Is_Extending_All
);
646 procedure Set_Is_Not_Last_In_List
647 (Node
: Project_Node_Id
;
648 In_Tree
: Project_Node_Tree_Ref
);
649 pragma Inline
(Set_Is_Not_Last_In_List
);
651 procedure Set_First_Variable_Of
652 (Node
: Project_Node_Id
;
653 In_Tree
: Project_Node_Tree_Ref
;
654 To
: Variable_Node_Id
);
655 pragma Inline
(Set_First_Variable_Of
);
657 procedure Set_First_Package_Of
658 (Node
: Project_Node_Id
;
659 In_Tree
: Project_Node_Tree_Ref
;
660 To
: Package_Declaration_Id
);
661 pragma Inline
(Set_First_Package_Of
);
663 procedure Set_Package_Id_Of
664 (Node
: Project_Node_Id
;
665 In_Tree
: Project_Node_Tree_Ref
;
666 To
: Package_Node_Id
);
667 pragma Inline
(Set_Package_Id_Of
);
669 procedure Set_Path_Name_Of
670 (Node
: Project_Node_Id
;
671 In_Tree
: Project_Node_Tree_Ref
;
673 pragma Inline
(Set_Path_Name_Of
);
675 procedure Set_String_Value_Of
676 (Node
: Project_Node_Id
;
677 In_Tree
: Project_Node_Tree_Ref
;
679 pragma Inline
(Set_String_Value_Of
);
681 procedure Set_First_With_Clause_Of
682 (Node
: Project_Node_Id
;
683 In_Tree
: Project_Node_Tree_Ref
;
684 To
: Project_Node_Id
);
685 pragma Inline
(Set_First_With_Clause_Of
);
687 procedure Set_Project_Declaration_Of
688 (Node
: Project_Node_Id
;
689 In_Tree
: Project_Node_Tree_Ref
;
690 To
: Project_Node_Id
);
691 pragma Inline
(Set_Project_Declaration_Of
);
693 procedure Set_Extending_Project_Of
694 (Node
: Project_Node_Id
;
695 In_Tree
: Project_Node_Tree_Ref
;
696 To
: Project_Node_Id
);
697 pragma Inline
(Set_Extending_Project_Of
);
699 procedure Set_First_String_Type_Of
700 (Node
: Project_Node_Id
;
701 In_Tree
: Project_Node_Tree_Ref
;
702 To
: Project_Node_Id
);
703 pragma Inline
(Set_First_String_Type_Of
);
705 procedure Set_Extended_Project_Path_Of
706 (Node
: Project_Node_Id
;
707 In_Tree
: Project_Node_Tree_Ref
;
709 pragma Inline
(Set_Extended_Project_Path_Of
);
711 procedure Set_Project_Node_Of
712 (Node
: Project_Node_Id
;
713 In_Tree
: Project_Node_Tree_Ref
;
714 To
: Project_Node_Id
;
715 Limited_With
: Boolean := False);
716 pragma Inline
(Set_Project_Node_Of
);
718 procedure Set_Next_With_Clause_Of
719 (Node
: Project_Node_Id
;
720 In_Tree
: Project_Node_Tree_Ref
;
721 To
: Project_Node_Id
);
722 pragma Inline
(Set_Next_With_Clause_Of
);
724 procedure Set_First_Declarative_Item_Of
725 (Node
: Project_Node_Id
;
726 In_Tree
: Project_Node_Tree_Ref
;
727 To
: Project_Node_Id
);
728 pragma Inline
(Set_First_Declarative_Item_Of
);
730 procedure Set_Extended_Project_Of
731 (Node
: Project_Node_Id
;
732 In_Tree
: Project_Node_Tree_Ref
;
733 To
: Project_Node_Id
);
734 pragma Inline
(Set_Extended_Project_Of
);
736 procedure Set_Current_Item_Node
737 (Node
: Project_Node_Id
;
738 In_Tree
: Project_Node_Tree_Ref
;
739 To
: Project_Node_Id
);
740 pragma Inline
(Set_Current_Item_Node
);
742 procedure Set_Next_Declarative_Item
743 (Node
: Project_Node_Id
;
744 In_Tree
: Project_Node_Tree_Ref
;
745 To
: Project_Node_Id
);
746 pragma Inline
(Set_Next_Declarative_Item
);
748 procedure Set_Project_Of_Renamed_Package_Of
749 (Node
: Project_Node_Id
;
750 In_Tree
: Project_Node_Tree_Ref
;
751 To
: Project_Node_Id
);
752 pragma Inline
(Set_Project_Of_Renamed_Package_Of
);
754 procedure Set_Next_Package_In_Project
755 (Node
: Project_Node_Id
;
756 In_Tree
: Project_Node_Tree_Ref
;
757 To
: Project_Node_Id
);
758 pragma Inline
(Set_Next_Package_In_Project
);
760 procedure Set_First_Literal_String
761 (Node
: Project_Node_Id
;
762 In_Tree
: Project_Node_Tree_Ref
;
763 To
: Project_Node_Id
);
764 pragma Inline
(Set_First_Literal_String
);
766 procedure Set_Next_String_Type
767 (Node
: Project_Node_Id
;
768 In_Tree
: Project_Node_Tree_Ref
;
769 To
: Project_Node_Id
);
770 pragma Inline
(Set_Next_String_Type
);
772 procedure Set_Next_Literal_String
773 (Node
: Project_Node_Id
;
774 In_Tree
: Project_Node_Tree_Ref
;
775 To
: Project_Node_Id
);
776 pragma Inline
(Set_Next_Literal_String
);
778 procedure Set_Expression_Of
779 (Node
: Project_Node_Id
;
780 In_Tree
: Project_Node_Tree_Ref
;
781 To
: Project_Node_Id
);
782 pragma Inline
(Set_Expression_Of
);
784 procedure Set_Associative_Project_Of
785 (Node
: Project_Node_Id
;
786 In_Tree
: Project_Node_Tree_Ref
;
787 To
: Project_Node_Id
);
788 pragma Inline
(Set_Associative_Project_Of
);
790 procedure Set_Associative_Package_Of
791 (Node
: Project_Node_Id
;
792 In_Tree
: Project_Node_Tree_Ref
;
793 To
: Project_Node_Id
);
794 pragma Inline
(Set_Associative_Package_Of
);
796 procedure Set_Associative_Array_Index_Of
797 (Node
: Project_Node_Id
;
798 In_Tree
: Project_Node_Tree_Ref
;
800 pragma Inline
(Set_Associative_Array_Index_Of
);
802 procedure Set_Next_Variable
803 (Node
: Project_Node_Id
;
804 In_Tree
: Project_Node_Tree_Ref
;
805 To
: Project_Node_Id
);
806 pragma Inline
(Set_Next_Variable
);
808 procedure Set_First_Term
809 (Node
: Project_Node_Id
;
810 In_Tree
: Project_Node_Tree_Ref
;
811 To
: Project_Node_Id
);
812 pragma Inline
(Set_First_Term
);
814 procedure Set_Next_Expression_In_List
815 (Node
: Project_Node_Id
;
816 In_Tree
: Project_Node_Tree_Ref
;
817 To
: Project_Node_Id
);
818 pragma Inline
(Set_Next_Expression_In_List
);
820 procedure Set_Current_Term
821 (Node
: Project_Node_Id
;
822 In_Tree
: Project_Node_Tree_Ref
;
823 To
: Project_Node_Id
);
824 pragma Inline
(Set_Current_Term
);
826 procedure Set_Next_Term
827 (Node
: Project_Node_Id
;
828 In_Tree
: Project_Node_Tree_Ref
;
829 To
: Project_Node_Id
);
830 pragma Inline
(Set_Next_Term
);
832 procedure Set_First_Expression_In_List
833 (Node
: Project_Node_Id
;
834 In_Tree
: Project_Node_Tree_Ref
;
835 To
: Project_Node_Id
);
836 pragma Inline
(Set_First_Expression_In_List
);
838 procedure Set_Package_Node_Of
839 (Node
: Project_Node_Id
;
840 In_Tree
: Project_Node_Tree_Ref
;
841 To
: Project_Node_Id
);
842 pragma Inline
(Set_Package_Node_Of
);
844 procedure Set_Source_Index_Of
845 (Node
: Project_Node_Id
;
846 In_Tree
: Project_Node_Tree_Ref
;
848 pragma Inline
(Set_Source_Index_Of
);
850 procedure Set_String_Type_Of
851 (Node
: Project_Node_Id
;
852 In_Tree
: Project_Node_Tree_Ref
;
853 To
: Project_Node_Id
);
854 pragma Inline
(Set_String_Type_Of
);
856 procedure Set_External_Reference_Of
857 (Node
: Project_Node_Id
;
858 In_Tree
: Project_Node_Tree_Ref
;
859 To
: Project_Node_Id
);
860 pragma Inline
(Set_External_Reference_Of
);
862 procedure Set_External_Default_Of
863 (Node
: Project_Node_Id
;
864 In_Tree
: Project_Node_Tree_Ref
;
865 To
: Project_Node_Id
);
866 pragma Inline
(Set_External_Default_Of
);
868 procedure Set_Case_Variable_Reference_Of
869 (Node
: Project_Node_Id
;
870 In_Tree
: Project_Node_Tree_Ref
;
871 To
: Project_Node_Id
);
872 pragma Inline
(Set_Case_Variable_Reference_Of
);
874 procedure Set_First_Case_Item_Of
875 (Node
: Project_Node_Id
;
876 In_Tree
: Project_Node_Tree_Ref
;
877 To
: Project_Node_Id
);
878 pragma Inline
(Set_First_Case_Item_Of
);
880 procedure Set_First_Choice_Of
881 (Node
: Project_Node_Id
;
882 In_Tree
: Project_Node_Tree_Ref
;
883 To
: Project_Node_Id
);
884 pragma Inline
(Set_First_Choice_Of
);
886 procedure Set_Next_Case_Item
887 (Node
: Project_Node_Id
;
888 In_Tree
: Project_Node_Tree_Ref
;
889 To
: Project_Node_Id
);
890 pragma Inline
(Set_Next_Case_Item
);
892 procedure Set_Case_Insensitive
893 (Node
: Project_Node_Id
;
894 In_Tree
: Project_Node_Tree_Ref
;
897 -------------------------------
898 -- Restricted Access Section --
899 -------------------------------
901 package Tree_Private_Part
is
903 -- This is conceptually in the private part.
904 -- However, for efficiency, some packages are accessing it directly.
906 type Project_Node_Record
is record
908 Kind
: Project_Node_Kind
;
910 Location
: Source_Ptr
:= No_Location
;
912 Directory
: Name_Id
:= No_Name
;
913 -- Only for N_Project
915 Expr_Kind
: Variable_Kind
:= Undefined
;
916 -- See below for what Project_Node_Kind it is used
918 Variables
: Variable_Node_Id
:= Empty_Node
;
919 -- First variable in a project or a package
921 Packages
: Package_Declaration_Id
:= Empty_Node
;
922 -- First package declaration in a project
924 Pkg_Id
: Package_Node_Id
:= Empty_Package
;
925 -- Only used for N_Package_Declaration
926 -- The component Pkg_Id is an entry into the table Package_Attributes
927 -- (in Prj.Attr). It is used to indicate all the attributes of the
928 -- package with their characteristics.
930 -- The tables Prj.Attr.Attributes and Prj.Attr.Package_Attributes
931 -- are built once and for all through a call (from Prj.Initialize)
932 -- to procedure Prj.Attr.Initialize. It is never modified after that.
934 Name
: Name_Id
:= No_Name
;
935 -- See below for what Project_Node_Kind it is used
937 Src_Index
: Int
:= 0;
938 -- Index of a unit in a multi-unit source.
939 -- Onli for some N_Attribute_Declaration and N_Literal_String.
941 Path_Name
: Name_Id
:= No_Name
;
942 -- See below for what Project_Node_Kind it is used
944 Value
: Name_Id
:= No_Name
;
945 -- See below for what Project_Node_Kind it is used
947 Field1
: Project_Node_Id
:= Empty_Node
;
948 -- See below the meaning for each Project_Node_Kind
950 Field2
: Project_Node_Id
:= Empty_Node
;
951 -- See below the meaning for each Project_Node_Kind
953 Field3
: Project_Node_Id
:= Empty_Node
;
954 -- See below the meaning for each Project_Node_Kind
956 Flag1
: Boolean := False;
957 -- This flag is significant only for:
958 -- N_Attribute_Declaration and N_Atribute_Reference
959 -- It indicates for an associative array attribute, that the
960 -- index is case insensitive.
961 -- N_Comment - it indicates that the comment is preceded by an
963 -- N_Project - it indicates that there are comments in the project
964 -- source that cannot be kept in the tree.
965 -- N_Project_Declaration
966 -- - it indicates that there are unkept comments in the
969 -- - it indicates that this is not the last with in a
970 -- with clause. It is set for "A", but not for "B" in
975 Flag2
: Boolean := False;
976 -- This flag is significant only for:
977 -- N_Project - it indicates that the project "extends all" another
979 -- N_Comment - it indicates that the comment is followed by an
982 -- - it indicates that the originally imported project
983 -- is an extending all project.
985 Comments
: Project_Node_Id
:= Empty_Node
;
986 -- For nodes other that N_Comment_Zones or N_Comment, designates the
987 -- comment zones associated with the node.
988 -- for N_Comment_Zones, designates the comment after the "end" of
990 -- For N_Comment, designates the next comment, if any.
994 -- type Project_Node_Kind is
997 -- -- Name: project name
998 -- -- Path_Name: project path name
999 -- -- Expr_Kind: Undefined
1000 -- -- Field1: first with clause
1001 -- -- Field2: project declaration
1002 -- -- Field3: first string type
1003 -- -- Value: extended project path name (if any)
1006 -- -- Name: imported project name
1007 -- -- Path_Name: imported project path name
1008 -- -- Expr_Kind: Undefined
1009 -- -- Field1: project node
1010 -- -- Field2: next with clause
1011 -- -- Field3: project node or empty if "limited with"
1012 -- -- Value: literal string withed
1014 -- N_Project_Declaration,
1015 -- -- Name: not used
1016 -- -- Path_Name: not used
1017 -- -- Expr_Kind: Undefined
1018 -- -- Field1: first declarative item
1019 -- -- Field2: extended project
1020 -- -- Field3: extending project
1021 -- -- Value: not used
1023 -- N_Declarative_Item,
1024 -- -- Name: not used
1025 -- -- Path_Name: not used
1026 -- -- Expr_Kind: Undefined
1027 -- -- Field1: current item node
1028 -- -- Field2: next declarative item
1029 -- -- Field3: not used
1030 -- -- Value: not used
1032 -- N_Package_Declaration,
1033 -- -- Name: package name
1034 -- -- Path_Name: not used
1035 -- -- Expr_Kind: Undefined
1036 -- -- Field1: project of renamed package (if any)
1037 -- -- Field2: first declarative item
1038 -- -- Field3: next package in project
1039 -- -- Value: not used
1041 -- N_String_Type_Declaration,
1042 -- -- Name: type name
1043 -- -- Path_Name: not used
1044 -- -- Expr_Kind: Undefined
1045 -- -- Field1: first literal string
1046 -- -- Field2: next string type
1047 -- -- Field3: not used
1048 -- -- Value: not used
1050 -- N_Literal_String,
1051 -- -- Name: not used
1052 -- -- Path_Name: not used
1053 -- -- Expr_Kind: Single
1054 -- -- Field1: next literal string
1055 -- -- Field2: not used
1056 -- -- Field3: not used
1057 -- -- Value: string value
1059 -- N_Attribute_Declaration,
1060 -- -- Name: attribute name
1061 -- -- Path_Name: not used
1062 -- -- Expr_Kind: attribute kind
1063 -- -- Field1: expression
1064 -- -- Field2: project of full associative array
1065 -- -- Field3: package of full associative array
1066 -- -- Value: associative array index
1067 -- -- (if an associative array element)
1069 -- N_Typed_Variable_Declaration,
1070 -- -- Name: variable name
1071 -- -- Path_Name: not used
1072 -- -- Expr_Kind: Single
1073 -- -- Field1: expression
1074 -- -- Field2: type of variable (N_String_Type_Declaration)
1075 -- -- Field3: next variable
1076 -- -- Value: not used
1078 -- N_Variable_Declaration,
1079 -- -- Name: variable name
1080 -- -- Path_Name: not used
1081 -- -- Expr_Kind: variable kind
1082 -- -- Field1: expression
1083 -- -- Field2: not used
1084 -- -- Field3 is used for next variable, instead of Field2,
1085 -- -- so that it is the same field for
1086 -- -- N_Variable_Declaration and
1087 -- -- N_Typed_Variable_Declaration
1088 -- -- Field3: next variable
1089 -- -- Value: not used
1092 -- -- Name: not used
1093 -- -- Path_Name: not used
1094 -- -- Expr_Kind: expression kind
1095 -- -- Field1: first term
1096 -- -- Field2: next expression in list
1097 -- -- Field3: not used
1098 -- -- Value: not used
1101 -- -- Name: not used
1102 -- -- Path_Name: not used
1103 -- -- Expr_Kind: term kind
1104 -- -- Field1: current term
1105 -- -- Field2: next term in the expression
1106 -- -- Field3: not used
1107 -- -- Value: not used
1109 -- N_Literal_String_List,
1110 -- -- Designates a list of string expressions between brackets
1111 -- -- separated by commas. The string expressions are not necessarily
1112 -- -- literal strings.
1113 -- -- Name: not used
1114 -- -- Path_Name: not used
1115 -- -- Expr_Kind: List
1116 -- -- Field1: first expression
1117 -- -- Field2: not used
1118 -- -- Field3: not used
1119 -- -- Value: not used
1121 -- N_Variable_Reference,
1122 -- -- Name: variable name
1123 -- -- Path_Name: not used
1124 -- -- Expr_Kind: variable kind
1125 -- -- Field1: project (if specified)
1126 -- -- Field2: package (if specified)
1127 -- -- Field3: type of variable (N_String_Type_Declaration), if any
1128 -- -- Value: not used
1130 -- N_External_Value,
1131 -- -- Name: not used
1132 -- -- Path_Name: not used
1133 -- -- Expr_Kind: Single
1134 -- -- Field1: Name of the external reference (literal string)
1135 -- -- Field2: Default (literal string)
1136 -- -- Field3: not used
1137 -- -- Value: not used
1139 -- N_Attribute_Reference,
1140 -- -- Name: attribute name
1141 -- -- Path_Name: not used
1142 -- -- Expr_Kind: attribute kind
1143 -- -- Field1: project
1144 -- -- Field2: package (if attribute of a package)
1145 -- -- Field3: not used
1146 -- -- Value: associative array index
1147 -- -- (if an associative array element)
1149 -- N_Case_Construction,
1150 -- -- Name: not used
1151 -- -- Path_Name: not used
1152 -- -- Expr_Kind: Undefined
1153 -- -- Field1: case variable reference
1154 -- -- Field2: first case item
1155 -- -- Field3: not used
1156 -- -- Value: not used
1159 -- -- Name: not used
1160 -- -- Path_Name: not used
1161 -- -- Expr_Kind: not used
1162 -- -- Field1: first choice (literal string), or Empty_Node
1163 -- -- for when others
1164 -- -- Field2: first declarative item
1165 -- -- Field3: next case item
1166 -- -- Value: not used
1169 -- -- Name: not used
1170 -- -- Path_Name: not used
1171 -- -- Expr_Kind: not used
1172 -- -- Field1: comment before the construct
1173 -- -- Field2: comment after the construct
1174 -- -- Field3: comment before the "end" of the construct
1175 -- -- Value: end of line comment
1176 -- -- Comments: comment after the "end" of the construct
1179 -- -- Name: not used
1180 -- -- Path_Name: not used
1181 -- -- Expr_Kind: not used
1182 -- -- Field1: not used
1183 -- -- Field2: not used
1184 -- -- Field3: not used
1185 -- -- Value: comment
1186 -- -- Flag1: comment is preceded by an empty line
1187 -- -- Flag2: comment is followed by an empty line
1188 -- -- Comments: next comment
1190 package Project_Node_Table
is
1191 new GNAT
.Dynamic_Tables
1192 (Table_Component_Type
=> Project_Node_Record
,
1193 Table_Index_Type
=> Project_Node_Id
,
1194 Table_Low_Bound
=> First_Node_Id
,
1195 Table_Initial
=> Project_Nodes_Initial
,
1196 Table_Increment
=> Project_Nodes_Increment
);
1197 -- This table contains the syntactic tree of project data
1198 -- from project files.
1200 type Project_Name_And_Node
is record
1202 -- Name of the project
1204 Node
: Project_Node_Id
;
1205 -- Node of the project in table Project_Nodes
1207 Canonical_Path
: Name_Id
;
1208 -- Resolved and canonical path of the project file
1211 -- True when the project is being extended by another project
1214 No_Project_Name_And_Node
: constant Project_Name_And_Node
:=
1217 Canonical_Path
=> No_Name
,
1220 package Projects_Htable
is new GNAT
.Dynamic_HTables
.Simple_HTable
1221 (Header_Num
=> Header_Num
,
1222 Element
=> Project_Name_And_Node
,
1223 No_Element
=> No_Project_Name_And_Node
,
1227 -- This hash table contains a mapping of project names to project nodes.
1228 -- Note that this hash table contains only the nodes whose Kind is
1229 -- N_Project. It is used to find the node of a project from its
1230 -- name, and to verify if a project has already been parsed, knowing
1233 end Tree_Private_Part
;
1235 type Project_Node_Tree_Data
is record
1236 Project_Nodes
: Tree_Private_Part
.Project_Node_Table
.Instance
;
1237 Projects_HT
: Tree_Private_Part
.Projects_Htable
.Instance
;
1239 -- The data for a project node tree
1242 type Comment_Array
is array (Positive range <>) of Comment_Data
;
1243 type Comments_Ptr
is access Comment_Array
;
1245 type Comment_State
is record
1246 End_Of_Line_Node
: Project_Node_Id
:= Empty_Node
;
1248 Previous_Line_Node
: Project_Node_Id
:= Empty_Node
;
1250 Previous_End_Node
: Project_Node_Id
:= Empty_Node
;
1252 Unkept_Comments
: Boolean := False;
1254 Comments
: Comments_Ptr
:= null;