1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 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 Path_Name_Type
;
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 Path_Name_Type
;
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 Path_Name_Type
;
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
;
632 To
: Path_Name_Type
);
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
;
672 To
: Path_Name_Type
);
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
;
708 To
: Path_Name_Type
);
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
905 -- However, for efficiency, some packages are accessing it directly
907 type Project_Node_Record
is record
909 Kind
: Project_Node_Kind
;
911 Location
: Source_Ptr
:= No_Location
;
913 Directory
: Path_Name_Type
:= No_Path
;
914 -- Only for N_Project
916 Expr_Kind
: Variable_Kind
:= Undefined
;
917 -- See below for what Project_Node_Kind it is used
919 Variables
: Variable_Node_Id
:= Empty_Node
;
920 -- First variable in a project or a package
922 Packages
: Package_Declaration_Id
:= Empty_Node
;
923 -- First package declaration in a project
925 Pkg_Id
: Package_Node_Id
:= Empty_Package
;
926 -- Only used for N_Package_Declaration
927 -- The component Pkg_Id is an entry into the table Package_Attributes
928 -- (in Prj.Attr). It is used to indicate all the attributes of the
929 -- package with their characteristics.
931 -- The tables Prj.Attr.Attributes and Prj.Attr.Package_Attributes
932 -- are built once and for all through a call (from Prj.Initialize)
933 -- to procedure Prj.Attr.Initialize. It is never modified after that.
935 Name
: Name_Id
:= No_Name
;
936 -- See below for what Project_Node_Kind it is used
938 Src_Index
: Int
:= 0;
939 -- Index of a unit in a multi-unit source.
940 -- Onli for some N_Attribute_Declaration and N_Literal_String.
942 Path_Name
: Path_Name_Type
:= No_Path
;
943 -- See below for what Project_Node_Kind it is used
945 Value
: Name_Id
:= No_Name
;
946 -- See below for what Project_Node_Kind it is used
948 Field1
: Project_Node_Id
:= Empty_Node
;
949 -- See below the meaning for each Project_Node_Kind
951 Field2
: Project_Node_Id
:= Empty_Node
;
952 -- See below the meaning for each Project_Node_Kind
954 Field3
: Project_Node_Id
:= Empty_Node
;
955 -- See below the meaning for each Project_Node_Kind
957 Flag1
: Boolean := False;
958 -- This flag is significant only for:
959 -- N_Attribute_Declaration and N_Atribute_Reference
960 -- It indicates for an associative array attribute, that the
961 -- index is case insensitive.
962 -- N_Comment - it indicates that the comment is preceded by an
964 -- N_Project - it indicates that there are comments in the project
965 -- source that cannot be kept in the tree.
966 -- N_Project_Declaration
967 -- - it indicates that there are unkept comments in the
970 -- - it indicates that this is not the last with in a
971 -- with clause. It is set for "A", but not for "B" in
976 Flag2
: Boolean := False;
977 -- This flag is significant only for:
978 -- N_Project - it indicates that the project "extends all" another
980 -- N_Comment - it indicates that the comment is followed by an
983 -- - it indicates that the originally imported project
984 -- is an extending all project.
986 Comments
: Project_Node_Id
:= Empty_Node
;
987 -- For nodes other that N_Comment_Zones or N_Comment, designates the
988 -- comment zones associated with the node.
989 -- for N_Comment_Zones, designates the comment after the "end" of
991 -- For N_Comment, designates the next comment, if any.
995 -- type Project_Node_Kind is
998 -- -- Name: project name
999 -- -- Path_Name: project path name
1000 -- -- Expr_Kind: Undefined
1001 -- -- Field1: first with clause
1002 -- -- Field2: project declaration
1003 -- -- Field3: first string type
1004 -- -- Value: extended project path name (if any)
1007 -- -- Name: imported project name
1008 -- -- Path_Name: imported project path name
1009 -- -- Expr_Kind: Undefined
1010 -- -- Field1: project node
1011 -- -- Field2: next with clause
1012 -- -- Field3: project node or empty if "limited with"
1013 -- -- Value: literal string withed
1015 -- N_Project_Declaration,
1016 -- -- Name: not used
1017 -- -- Path_Name: not used
1018 -- -- Expr_Kind: Undefined
1019 -- -- Field1: first declarative item
1020 -- -- Field2: extended project
1021 -- -- Field3: extending project
1022 -- -- Value: not used
1024 -- N_Declarative_Item,
1025 -- -- Name: not used
1026 -- -- Path_Name: not used
1027 -- -- Expr_Kind: Undefined
1028 -- -- Field1: current item node
1029 -- -- Field2: next declarative item
1030 -- -- Field3: not used
1031 -- -- Value: not used
1033 -- N_Package_Declaration,
1034 -- -- Name: package name
1035 -- -- Path_Name: not used
1036 -- -- Expr_Kind: Undefined
1037 -- -- Field1: project of renamed package (if any)
1038 -- -- Field2: first declarative item
1039 -- -- Field3: next package in project
1040 -- -- Value: not used
1042 -- N_String_Type_Declaration,
1043 -- -- Name: type name
1044 -- -- Path_Name: not used
1045 -- -- Expr_Kind: Undefined
1046 -- -- Field1: first literal string
1047 -- -- Field2: next string type
1048 -- -- Field3: not used
1049 -- -- Value: not used
1051 -- N_Literal_String,
1052 -- -- Name: not used
1053 -- -- Path_Name: not used
1054 -- -- Expr_Kind: Single
1055 -- -- Field1: next literal string
1056 -- -- Field2: not used
1057 -- -- Field3: not used
1058 -- -- Value: string value
1060 -- N_Attribute_Declaration,
1061 -- -- Name: attribute name
1062 -- -- Path_Name: not used
1063 -- -- Expr_Kind: attribute kind
1064 -- -- Field1: expression
1065 -- -- Field2: project of full associative array
1066 -- -- Field3: package of full associative array
1067 -- -- Value: associative array index
1068 -- -- (if an associative array element)
1070 -- N_Typed_Variable_Declaration,
1071 -- -- Name: variable name
1072 -- -- Path_Name: not used
1073 -- -- Expr_Kind: Single
1074 -- -- Field1: expression
1075 -- -- Field2: type of variable (N_String_Type_Declaration)
1076 -- -- Field3: next variable
1077 -- -- Value: not used
1079 -- N_Variable_Declaration,
1080 -- -- Name: variable name
1081 -- -- Path_Name: not used
1082 -- -- Expr_Kind: variable kind
1083 -- -- Field1: expression
1084 -- -- Field2: not used
1085 -- -- Field3 is used for next variable, instead of Field2,
1086 -- -- so that it is the same field for
1087 -- -- N_Variable_Declaration and
1088 -- -- N_Typed_Variable_Declaration
1089 -- -- Field3: next variable
1090 -- -- Value: not used
1093 -- -- Name: not used
1094 -- -- Path_Name: not used
1095 -- -- Expr_Kind: expression kind
1096 -- -- Field1: first term
1097 -- -- Field2: next expression in list
1098 -- -- Field3: not used
1099 -- -- Value: not used
1102 -- -- Name: not used
1103 -- -- Path_Name: not used
1104 -- -- Expr_Kind: term kind
1105 -- -- Field1: current term
1106 -- -- Field2: next term in the expression
1107 -- -- Field3: not used
1108 -- -- Value: not used
1110 -- N_Literal_String_List,
1111 -- -- Designates a list of string expressions between brackets
1112 -- -- separated by commas. The string expressions are not necessarily
1113 -- -- literal strings.
1114 -- -- Name: not used
1115 -- -- Path_Name: not used
1116 -- -- Expr_Kind: List
1117 -- -- Field1: first expression
1118 -- -- Field2: not used
1119 -- -- Field3: not used
1120 -- -- Value: not used
1122 -- N_Variable_Reference,
1123 -- -- Name: variable name
1124 -- -- Path_Name: not used
1125 -- -- Expr_Kind: variable kind
1126 -- -- Field1: project (if specified)
1127 -- -- Field2: package (if specified)
1128 -- -- Field3: type of variable (N_String_Type_Declaration), if any
1129 -- -- Value: not used
1131 -- N_External_Value,
1132 -- -- Name: not used
1133 -- -- Path_Name: not used
1134 -- -- Expr_Kind: Single
1135 -- -- Field1: Name of the external reference (literal string)
1136 -- -- Field2: Default (literal string)
1137 -- -- Field3: not used
1138 -- -- Value: not used
1140 -- N_Attribute_Reference,
1141 -- -- Name: attribute name
1142 -- -- Path_Name: not used
1143 -- -- Expr_Kind: attribute kind
1144 -- -- Field1: project
1145 -- -- Field2: package (if attribute of a package)
1146 -- -- Field3: not used
1147 -- -- Value: associative array index
1148 -- -- (if an associative array element)
1150 -- N_Case_Construction,
1151 -- -- Name: not used
1152 -- -- Path_Name: not used
1153 -- -- Expr_Kind: Undefined
1154 -- -- Field1: case variable reference
1155 -- -- Field2: first case item
1156 -- -- Field3: not used
1157 -- -- Value: not used
1160 -- -- Name: not used
1161 -- -- Path_Name: not used
1162 -- -- Expr_Kind: not used
1163 -- -- Field1: first choice (literal string), or Empty_Node
1164 -- -- for when others
1165 -- -- Field2: first declarative item
1166 -- -- Field3: next case item
1167 -- -- Value: not used
1170 -- -- Name: not used
1171 -- -- Path_Name: not used
1172 -- -- Expr_Kind: not used
1173 -- -- Field1: comment before the construct
1174 -- -- Field2: comment after the construct
1175 -- -- Field3: comment before the "end" of the construct
1176 -- -- Value: end of line comment
1177 -- -- Comments: comment after the "end" of the construct
1180 -- -- Name: not used
1181 -- -- Path_Name: not used
1182 -- -- Expr_Kind: not used
1183 -- -- Field1: not used
1184 -- -- Field2: not used
1185 -- -- Field3: not used
1186 -- -- Value: comment
1187 -- -- Flag1: comment is preceded by an empty line
1188 -- -- Flag2: comment is followed by an empty line
1189 -- -- Comments: next comment
1191 package Project_Node_Table
is
1192 new GNAT
.Dynamic_Tables
1193 (Table_Component_Type
=> Project_Node_Record
,
1194 Table_Index_Type
=> Project_Node_Id
,
1195 Table_Low_Bound
=> First_Node_Id
,
1196 Table_Initial
=> Project_Nodes_Initial
,
1197 Table_Increment
=> Project_Nodes_Increment
);
1198 -- This table contains the syntactic tree of project data
1199 -- from project files.
1201 type Project_Name_And_Node
is record
1203 -- Name of the project
1205 Node
: Project_Node_Id
;
1206 -- Node of the project in table Project_Nodes
1208 Canonical_Path
: Path_Name_Type
;
1209 -- Resolved and canonical path of the project file
1212 -- True when the project is being extended by another project
1215 No_Project_Name_And_Node
: constant Project_Name_And_Node
:=
1218 Canonical_Path
=> No_Path
,
1221 package Projects_Htable
is new GNAT
.Dynamic_HTables
.Simple_HTable
1222 (Header_Num
=> Header_Num
,
1223 Element
=> Project_Name_And_Node
,
1224 No_Element
=> No_Project_Name_And_Node
,
1228 -- This hash table contains a mapping of project names to project nodes.
1229 -- Note that this hash table contains only the nodes whose Kind is
1230 -- N_Project. It is used to find the node of a project from its name,
1231 -- and to verify if a project has already been parsed, knowing its name.
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;