1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- This package defines the structure of the Project File tree
28 with GNAT
.Dynamic_HTables
;
29 with GNAT
.Dynamic_Tables
;
33 with Prj
.Attr
; use Prj
.Attr
;
37 type Project_Node_Tree_Data
;
38 type Project_Node_Tree_Ref
is access all Project_Node_Tree_Data
;
39 -- Type to designate a project node tree, so that several project node
40 -- trees can coexist in memory.
42 Project_Nodes_Initial
: constant := 1_000
;
43 Project_Nodes_Increment
: constant := 100;
44 -- Allocation parameters for initializing and extending number
45 -- of nodes in table Tree_Private_Part.Project_Nodes
47 Project_Node_Low_Bound
: constant := 0;
48 Project_Node_High_Bound
: constant := 099_999_999
;
49 -- Range of values for project node id's (in practice infinite)
51 type Project_Node_Id
is range
52 Project_Node_Low_Bound
.. Project_Node_High_Bound
;
53 -- The index of table Tree_Private_Part.Project_Nodes
55 Empty_Node
: constant Project_Node_Id
:= Project_Node_Low_Bound
;
56 -- Designates no node in table Project_Nodes
58 First_Node_Id
: constant Project_Node_Id
:= Project_Node_Low_Bound
+ 1;
60 subtype Variable_Node_Id
is Project_Node_Id
;
61 -- Used to designate a node whose expected kind is one of
62 -- N_Typed_Variable_Declaration, N_Variable_Declaration or
63 -- N_Variable_Reference.
65 subtype Package_Declaration_Id
is Project_Node_Id
;
66 -- Used to designate a node whose expected kind is N_Proect_Declaration
68 type Project_Node_Kind
is
71 N_Project_Declaration
,
73 N_Package_Declaration
,
74 N_String_Type_Declaration
,
76 N_Attribute_Declaration
,
77 N_Typed_Variable_Declaration
,
78 N_Variable_Declaration
,
81 N_Literal_String_List
,
84 N_Attribute_Reference
,
89 -- Each node in the tree is of a Project_Node_Kind. For the signification
90 -- of the fields in each node of Project_Node_Kind, look at package
93 procedure Initialize
(Tree
: Project_Node_Tree_Ref
);
94 -- Initialize the Project File tree: empty the Project_Nodes table
95 -- and reset the Projects_Htable.
97 function Default_Project_Node
98 (In_Tree
: Project_Node_Tree_Ref
;
99 Of_Kind
: Project_Node_Kind
;
100 And_Expr_Kind
: Variable_Kind
:= Undefined
) return Project_Node_Id
;
101 -- Returns a Project_Node_Record with the specified Kind and Expr_Kind. All
102 -- the other components have default nil values.
104 function Hash
(N
: Project_Node_Id
) return Header_Num
;
105 -- Used for hash tables where the key is a Project_Node_Id
107 function Imported_Or_Extended_Project_Of
108 (Project
: Project_Node_Id
;
109 In_Tree
: Project_Node_Tree_Ref
;
110 With_Name
: Name_Id
) return Project_Node_Id
;
111 -- Return the node of a project imported or extended by project Project and
112 -- whose name is With_Name. Return Empty_Node if there is no such project.
118 type Comment_State
is private;
119 -- A type to store the values of several global variables related to
122 procedure Save
(S
: out Comment_State
);
123 -- Save in variable S the comment state. Called before scanning a new
126 procedure Restore
(S
: Comment_State
);
127 -- Restore the comment state to a previously saved value. Called after
128 -- scanning a project file.
130 procedure Reset_State
;
131 -- Set the comment state to its initial value. Called before scanning a
134 function There_Are_Unkept_Comments
return Boolean;
135 -- Indicates that some of the comments in a project file could not be
136 -- stored in the parse tree.
138 procedure Set_Previous_Line_Node
(To
: Project_Node_Id
);
139 -- Indicate the node on the previous line. If there are comments
140 -- immediately following this line, then they should be associated with
143 procedure Set_Previous_End_Node
(To
: Project_Node_Id
);
144 -- Indicate that on the previous line the "end" belongs to node To.
145 -- If there are comments immediately following this "end" line, they
146 -- should be associated with this node.
148 procedure Set_End_Of_Line
(To
: Project_Node_Id
);
149 -- Indicate the node on the current line. If there is an end of line
150 -- comment, then it should be associated with this node.
152 procedure Set_Next_End_Node
(To
: Project_Node_Id
);
153 -- Put node To on the top of the end node stack. When an END line is found
154 -- with this node on the top of the end node stack, the comments, if any,
155 -- immediately preceding this "end" line will be associated with this node.
157 procedure Remove_Next_End_Node
;
158 -- Remove the top of the end node stack
160 ------------------------
161 -- Comment Processing --
162 ------------------------
164 type Comment_Data
is record
165 Value
: Name_Id
:= No_Name
;
166 Follows_Empty_Line
: Boolean := False;
167 Is_Followed_By_Empty_Line
: Boolean := False;
169 -- Component type for Comments Table below
171 package Comments
is new Table
.Table
172 (Table_Component_Type
=> Comment_Data
,
173 Table_Index_Type
=> Natural,
174 Table_Low_Bound
=> 1,
176 Table_Increment
=> 100,
177 Table_Name
=> "Prj.Tree.Comments");
178 -- A table to store the comments that may be stored is the tree
180 procedure Scan
(In_Tree
: Project_Node_Tree_Ref
);
181 -- Scan the tokens and accumulate comments
183 type Comment_Location
is
184 (Before
, After
, Before_End
, After_End
, End_Of_Line
);
185 -- Used in call to Add_Comments below
187 procedure Add_Comments
188 (To
: Project_Node_Id
;
189 In_Tree
: Project_Node_Tree_Ref
;
190 Where
: Comment_Location
);
191 -- Add comments to this node
193 ----------------------
194 -- Access Functions --
195 ----------------------
197 -- The following query functions are part of the abstract interface
198 -- of the Project File tree. They provide access to fields of a project.
200 -- The access functions should be called only with valid arguments.
201 -- For each function the condition of validity is specified. If an access
202 -- function is called with invalid arguments, then exception
203 -- Assertion_Error is raised if assertions are enabled, otherwise the
204 -- behaviour is not defined and may result in a crash.
207 (Node
: Project_Node_Id
;
208 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
209 pragma Inline
(Name_Of
);
210 -- Valid for all non empty nodes. May return No_Name for nodes that have
214 (Node
: Project_Node_Id
;
215 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Kind
;
216 pragma Inline
(Kind_Of
);
217 -- Valid for all non empty nodes
220 (Node
: Project_Node_Id
;
221 In_Tree
: Project_Node_Tree_Ref
) return Source_Ptr
;
222 pragma Inline
(Location_Of
);
223 -- Valid for all non empty nodes
225 function First_Comment_After
226 (Node
: Project_Node_Id
;
227 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
228 -- Valid only for N_Comment_Zones nodes
230 function First_Comment_After_End
231 (Node
: Project_Node_Id
;
232 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
233 -- Valid only for N_Comment_Zones nodes
235 function First_Comment_Before
236 (Node
: Project_Node_Id
;
237 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
238 -- Valid only for N_Comment_Zones nodes
240 function First_Comment_Before_End
241 (Node
: Project_Node_Id
;
242 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
243 -- Valid only for N_Comment_Zones nodes
245 function Next_Comment
246 (Node
: Project_Node_Id
;
247 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
248 -- Valid only for N_Comment nodes
250 function End_Of_Line_Comment
251 (Node
: Project_Node_Id
;
252 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
253 -- Valid only for non empty nodes
255 function Follows_Empty_Line
256 (Node
: Project_Node_Id
;
257 In_Tree
: Project_Node_Tree_Ref
) return Boolean;
258 -- Valid only for N_Comment nodes
260 function Is_Followed_By_Empty_Line
261 (Node
: Project_Node_Id
;
262 In_Tree
: Project_Node_Tree_Ref
) return Boolean;
263 -- Valid only for N_Comment nodes
265 function Project_File_Includes_Unkept_Comments
266 (Node
: Project_Node_Id
;
267 In_Tree
: Project_Node_Tree_Ref
)
269 -- Valid only for N_Project nodes
271 function Directory_Of
272 (Node
: Project_Node_Id
;
273 In_Tree
: Project_Node_Tree_Ref
) return Path_Name_Type
;
274 pragma Inline
(Directory_Of
);
275 -- Only valid for N_Project nodes
277 function Expression_Kind_Of
278 (Node
: Project_Node_Id
;
279 In_Tree
: Project_Node_Tree_Ref
) return Variable_Kind
;
280 pragma Inline
(Expression_Kind_Of
);
281 -- Only valid for N_Literal_String, N_Attribute_Declaration,
282 -- N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression,
283 -- N_Term, N_Variable_Reference or N_Attribute_Reference nodes.
285 function Is_Extending_All
286 (Node
: Project_Node_Id
;
287 In_Tree
: Project_Node_Tree_Ref
) return Boolean;
288 pragma Inline
(Is_Extending_All
);
289 -- Only valid for N_Project and N_With_Clause
291 function Is_Not_Last_In_List
292 (Node
: Project_Node_Id
;
293 In_Tree
: Project_Node_Tree_Ref
) return Boolean;
294 pragma Inline
(Is_Not_Last_In_List
);
295 -- Only valid for N_With_Clause
297 function First_Variable_Of
298 (Node
: Project_Node_Id
;
299 In_Tree
: Project_Node_Tree_Ref
) return Variable_Node_Id
;
300 pragma Inline
(First_Variable_Of
);
301 -- Only valid for N_Project or N_Package_Declaration nodes
303 function First_Package_Of
304 (Node
: Project_Node_Id
;
305 In_Tree
: Project_Node_Tree_Ref
) return Package_Declaration_Id
;
306 pragma Inline
(First_Package_Of
);
307 -- Only valid for N_Project nodes
309 function Package_Id_Of
310 (Node
: Project_Node_Id
;
311 In_Tree
: Project_Node_Tree_Ref
) return Package_Node_Id
;
312 pragma Inline
(Package_Id_Of
);
313 -- Only valid for N_Package_Declaration nodes
315 function Path_Name_Of
316 (Node
: Project_Node_Id
;
317 In_Tree
: Project_Node_Tree_Ref
) return Path_Name_Type
;
318 pragma Inline
(Path_Name_Of
);
319 -- Only valid for N_Project and N_With_Clause nodes
321 function String_Value_Of
322 (Node
: Project_Node_Id
;
323 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
324 pragma Inline
(String_Value_Of
);
325 -- Only valid for N_With_Clause, N_Literal_String nodes or N_Comment.
326 -- For a N_With_Clause created automatically for a virtual extending
327 -- project, No_Name is returned.
329 function Source_Index_Of
330 (Node
: Project_Node_Id
;
331 In_Tree
: Project_Node_Tree_Ref
) return Int
;
332 pragma Inline
(Source_Index_Of
);
333 -- Only valid for N_Literal_String and N_Attribute_Declaration nodes
335 function First_With_Clause_Of
336 (Node
: Project_Node_Id
;
337 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
338 pragma Inline
(First_With_Clause_Of
);
339 -- Only valid for N_Project nodes
341 function Project_Declaration_Of
342 (Node
: Project_Node_Id
;
343 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
344 pragma Inline
(Project_Declaration_Of
);
345 -- Only valid for N_Project nodes
347 function Extending_Project_Of
348 (Node
: Project_Node_Id
;
349 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
350 pragma Inline
(Extending_Project_Of
);
351 -- Only valid for N_Project_Declaration nodes
353 function First_String_Type_Of
354 (Node
: Project_Node_Id
;
355 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
356 pragma Inline
(First_String_Type_Of
);
357 -- Only valid for N_Project nodes
359 function Extended_Project_Path_Of
360 (Node
: Project_Node_Id
;
361 In_Tree
: Project_Node_Tree_Ref
) return Path_Name_Type
;
362 pragma Inline
(Extended_Project_Path_Of
);
363 -- Only valid for N_With_Clause nodes
365 function Project_Node_Of
366 (Node
: Project_Node_Id
;
367 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
368 pragma Inline
(Project_Node_Of
);
369 -- Only valid for N_With_Clause, N_Variable_Reference and
370 -- N_Attribute_Reference nodes.
372 function Non_Limited_Project_Node_Of
373 (Node
: Project_Node_Id
;
374 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
375 pragma Inline
(Non_Limited_Project_Node_Of
);
376 -- Only valid for N_With_Clause nodes. Returns Empty_Node for limited
377 -- imported project files, otherwise returns the same result as
380 function Next_With_Clause_Of
381 (Node
: Project_Node_Id
;
382 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
383 pragma Inline
(Next_With_Clause_Of
);
384 -- Only valid for N_With_Clause nodes
386 function First_Declarative_Item_Of
387 (Node
: Project_Node_Id
;
388 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
389 pragma Inline
(First_Declarative_Item_Of
);
390 -- Only valid for N_With_Clause nodes
392 function Extended_Project_Of
393 (Node
: Project_Node_Id
;
394 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
395 pragma Inline
(Extended_Project_Of
);
396 -- Only valid for N_Project_Declaration nodes
398 function Current_Item_Node
399 (Node
: Project_Node_Id
;
400 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
401 pragma Inline
(Current_Item_Node
);
402 -- Only valid for N_Declarative_Item nodes
404 function Next_Declarative_Item
405 (Node
: Project_Node_Id
;
406 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
407 pragma Inline
(Next_Declarative_Item
);
408 -- Only valid for N_Declarative_Item node
410 function Project_Of_Renamed_Package_Of
411 (Node
: Project_Node_Id
;
412 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
413 pragma Inline
(Project_Of_Renamed_Package_Of
);
414 -- Only valid for N_Package_Declaration nodes.
415 -- May return Empty_Node.
417 function Next_Package_In_Project
418 (Node
: Project_Node_Id
;
419 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
420 pragma Inline
(Next_Package_In_Project
);
421 -- Only valid for N_Package_Declaration nodes
423 function First_Literal_String
424 (Node
: Project_Node_Id
;
425 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
426 pragma Inline
(First_Literal_String
);
427 -- Only valid for N_String_Type_Declaration nodes
429 function Next_String_Type
430 (Node
: Project_Node_Id
;
431 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
432 pragma Inline
(Next_String_Type
);
433 -- Only valid for N_String_Type_Declaration nodes
435 function Next_Literal_String
436 (Node
: Project_Node_Id
;
437 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
438 pragma Inline
(Next_Literal_String
);
439 -- Only valid for N_Literal_String nodes
441 function Expression_Of
442 (Node
: Project_Node_Id
;
443 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
444 pragma Inline
(Expression_Of
);
445 -- Only valid for N_Attribute_Declaration, N_Typed_Variable_Declaration
446 -- or N_Variable_Declaration nodes
448 function Associative_Project_Of
449 (Node
: Project_Node_Id
;
450 In_Tree
: Project_Node_Tree_Ref
)
451 return Project_Node_Id
;
452 pragma Inline
(Associative_Project_Of
);
453 -- Only valid for N_Attribute_Declaration nodes
455 function Associative_Package_Of
456 (Node
: Project_Node_Id
;
457 In_Tree
: Project_Node_Tree_Ref
)
458 return Project_Node_Id
;
459 pragma Inline
(Associative_Package_Of
);
460 -- Only valid for N_Attribute_Declaration nodes
462 function Value_Is_Valid
463 (For_Typed_Variable
: Project_Node_Id
;
464 In_Tree
: Project_Node_Tree_Ref
;
465 Value
: Name_Id
) return Boolean;
466 pragma Inline
(Value_Is_Valid
);
467 -- Only valid for N_Typed_Variable_Declaration. Returns True if Value is
468 -- in the list of allowed strings for For_Typed_Variable. False otherwise.
470 function Associative_Array_Index_Of
471 (Node
: Project_Node_Id
;
472 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
473 pragma Inline
(Associative_Array_Index_Of
);
474 -- Only valid for N_Attribute_Declaration and N_Attribute_Reference.
475 -- Returns No_String for non associative array attributes.
477 function Next_Variable
478 (Node
: Project_Node_Id
;
479 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
480 pragma Inline
(Next_Variable
);
481 -- Only valid for N_Typed_Variable_Declaration or N_Variable_Declaration
485 (Node
: Project_Node_Id
;
486 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
487 pragma Inline
(First_Term
);
488 -- Only valid for N_Expression nodes
490 function Next_Expression_In_List
491 (Node
: Project_Node_Id
;
492 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
493 pragma Inline
(Next_Expression_In_List
);
494 -- Only valid for N_Expression nodes
496 function Current_Term
497 (Node
: Project_Node_Id
;
498 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
499 pragma Inline
(Current_Term
);
500 -- Only valid for N_Term nodes
503 (Node
: Project_Node_Id
;
504 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
505 pragma Inline
(Next_Term
);
506 -- Only valid for N_Term nodes
508 function First_Expression_In_List
509 (Node
: Project_Node_Id
;
510 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
511 pragma Inline
(First_Expression_In_List
);
512 -- Only valid for N_Literal_String_List nodes
514 function Package_Node_Of
515 (Node
: Project_Node_Id
;
516 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
517 pragma Inline
(Package_Node_Of
);
518 -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes.
519 -- May return Empty_Node.
521 function String_Type_Of
522 (Node
: Project_Node_Id
;
523 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
524 pragma Inline
(String_Type_Of
);
525 -- Only valid for N_Variable_Reference or N_Typed_Variable_Declaration
528 function External_Reference_Of
529 (Node
: Project_Node_Id
;
530 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
531 pragma Inline
(External_Reference_Of
);
532 -- Only valid for N_External_Value nodes
534 function External_Default_Of
535 (Node
: Project_Node_Id
;
536 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
537 pragma Inline
(External_Default_Of
);
538 -- Only valid for N_External_Value nodes
540 function Case_Variable_Reference_Of
541 (Node
: Project_Node_Id
;
542 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
543 pragma Inline
(Case_Variable_Reference_Of
);
544 -- Only valid for N_Case_Construction nodes
546 function First_Case_Item_Of
547 (Node
: Project_Node_Id
;
548 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
549 pragma Inline
(First_Case_Item_Of
);
550 -- Only valid for N_Case_Construction nodes
552 function First_Choice_Of
553 (Node
: Project_Node_Id
;
554 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
555 pragma Inline
(First_Choice_Of
);
556 -- Return the first choice in a N_Case_Item, or Empty_Node if
557 -- this is when others.
559 function Next_Case_Item
560 (Node
: Project_Node_Id
;
561 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
562 pragma Inline
(Next_Case_Item
);
563 -- Only valid for N_Case_Item nodes
565 function Case_Insensitive
566 (Node
: Project_Node_Id
;
567 In_Tree
: Project_Node_Tree_Ref
) return Boolean;
568 -- Only valid for N_Attribute_Declaration and N_Attribute_Reference nodes
574 -- The following procedures are part of the abstract interface of
575 -- the Project File tree.
577 -- Each Set_* procedure is valid only for the same Project_Node_Kind
578 -- nodes as the corresponding query function above.
580 procedure Set_Name_Of
581 (Node
: Project_Node_Id
;
582 In_Tree
: Project_Node_Tree_Ref
;
584 pragma Inline
(Set_Name_Of
);
586 procedure Set_Kind_Of
587 (Node
: Project_Node_Id
;
588 In_Tree
: Project_Node_Tree_Ref
;
589 To
: Project_Node_Kind
);
590 pragma Inline
(Set_Kind_Of
);
592 procedure Set_Location_Of
593 (Node
: Project_Node_Id
;
594 In_Tree
: Project_Node_Tree_Ref
;
596 pragma Inline
(Set_Location_Of
);
598 procedure Set_First_Comment_After
599 (Node
: Project_Node_Id
;
600 In_Tree
: Project_Node_Tree_Ref
;
601 To
: Project_Node_Id
);
602 pragma Inline
(Set_First_Comment_After
);
604 procedure Set_First_Comment_After_End
605 (Node
: Project_Node_Id
;
606 In_Tree
: Project_Node_Tree_Ref
;
607 To
: Project_Node_Id
);
608 pragma Inline
(Set_First_Comment_After_End
);
610 procedure Set_First_Comment_Before
611 (Node
: Project_Node_Id
;
612 In_Tree
: Project_Node_Tree_Ref
;
613 To
: Project_Node_Id
);
614 pragma Inline
(Set_First_Comment_Before
);
616 procedure Set_First_Comment_Before_End
617 (Node
: Project_Node_Id
;
618 In_Tree
: Project_Node_Tree_Ref
;
619 To
: Project_Node_Id
);
620 pragma Inline
(Set_First_Comment_Before_End
);
622 procedure Set_Next_Comment
623 (Node
: Project_Node_Id
;
624 In_Tree
: Project_Node_Tree_Ref
;
625 To
: Project_Node_Id
);
626 pragma Inline
(Set_Next_Comment
);
628 procedure Set_Project_File_Includes_Unkept_Comments
629 (Node
: Project_Node_Id
;
630 In_Tree
: Project_Node_Tree_Ref
;
633 procedure Set_Directory_Of
634 (Node
: Project_Node_Id
;
635 In_Tree
: Project_Node_Tree_Ref
;
636 To
: Path_Name_Type
);
637 pragma Inline
(Set_Directory_Of
);
639 procedure Set_Expression_Kind_Of
640 (Node
: Project_Node_Id
;
641 In_Tree
: Project_Node_Tree_Ref
;
643 pragma Inline
(Set_Expression_Kind_Of
);
645 procedure Set_Is_Extending_All
646 (Node
: Project_Node_Id
;
647 In_Tree
: Project_Node_Tree_Ref
);
648 pragma Inline
(Set_Is_Extending_All
);
650 procedure Set_Is_Not_Last_In_List
651 (Node
: Project_Node_Id
;
652 In_Tree
: Project_Node_Tree_Ref
);
653 pragma Inline
(Set_Is_Not_Last_In_List
);
655 procedure Set_First_Variable_Of
656 (Node
: Project_Node_Id
;
657 In_Tree
: Project_Node_Tree_Ref
;
658 To
: Variable_Node_Id
);
659 pragma Inline
(Set_First_Variable_Of
);
661 procedure Set_First_Package_Of
662 (Node
: Project_Node_Id
;
663 In_Tree
: Project_Node_Tree_Ref
;
664 To
: Package_Declaration_Id
);
665 pragma Inline
(Set_First_Package_Of
);
667 procedure Set_Package_Id_Of
668 (Node
: Project_Node_Id
;
669 In_Tree
: Project_Node_Tree_Ref
;
670 To
: Package_Node_Id
);
671 pragma Inline
(Set_Package_Id_Of
);
673 procedure Set_Path_Name_Of
674 (Node
: Project_Node_Id
;
675 In_Tree
: Project_Node_Tree_Ref
;
676 To
: Path_Name_Type
);
677 pragma Inline
(Set_Path_Name_Of
);
679 procedure Set_String_Value_Of
680 (Node
: Project_Node_Id
;
681 In_Tree
: Project_Node_Tree_Ref
;
683 pragma Inline
(Set_String_Value_Of
);
685 procedure Set_First_With_Clause_Of
686 (Node
: Project_Node_Id
;
687 In_Tree
: Project_Node_Tree_Ref
;
688 To
: Project_Node_Id
);
689 pragma Inline
(Set_First_With_Clause_Of
);
691 procedure Set_Project_Declaration_Of
692 (Node
: Project_Node_Id
;
693 In_Tree
: Project_Node_Tree_Ref
;
694 To
: Project_Node_Id
);
695 pragma Inline
(Set_Project_Declaration_Of
);
697 procedure Set_Extending_Project_Of
698 (Node
: Project_Node_Id
;
699 In_Tree
: Project_Node_Tree_Ref
;
700 To
: Project_Node_Id
);
701 pragma Inline
(Set_Extending_Project_Of
);
703 procedure Set_First_String_Type_Of
704 (Node
: Project_Node_Id
;
705 In_Tree
: Project_Node_Tree_Ref
;
706 To
: Project_Node_Id
);
707 pragma Inline
(Set_First_String_Type_Of
);
709 procedure Set_Extended_Project_Path_Of
710 (Node
: Project_Node_Id
;
711 In_Tree
: Project_Node_Tree_Ref
;
712 To
: Path_Name_Type
);
713 pragma Inline
(Set_Extended_Project_Path_Of
);
715 procedure Set_Project_Node_Of
716 (Node
: Project_Node_Id
;
717 In_Tree
: Project_Node_Tree_Ref
;
718 To
: Project_Node_Id
;
719 Limited_With
: Boolean := False);
720 pragma Inline
(Set_Project_Node_Of
);
722 procedure Set_Next_With_Clause_Of
723 (Node
: Project_Node_Id
;
724 In_Tree
: Project_Node_Tree_Ref
;
725 To
: Project_Node_Id
);
726 pragma Inline
(Set_Next_With_Clause_Of
);
728 procedure Set_First_Declarative_Item_Of
729 (Node
: Project_Node_Id
;
730 In_Tree
: Project_Node_Tree_Ref
;
731 To
: Project_Node_Id
);
732 pragma Inline
(Set_First_Declarative_Item_Of
);
734 procedure Set_Extended_Project_Of
735 (Node
: Project_Node_Id
;
736 In_Tree
: Project_Node_Tree_Ref
;
737 To
: Project_Node_Id
);
738 pragma Inline
(Set_Extended_Project_Of
);
740 procedure Set_Current_Item_Node
741 (Node
: Project_Node_Id
;
742 In_Tree
: Project_Node_Tree_Ref
;
743 To
: Project_Node_Id
);
744 pragma Inline
(Set_Current_Item_Node
);
746 procedure Set_Next_Declarative_Item
747 (Node
: Project_Node_Id
;
748 In_Tree
: Project_Node_Tree_Ref
;
749 To
: Project_Node_Id
);
750 pragma Inline
(Set_Next_Declarative_Item
);
752 procedure Set_Project_Of_Renamed_Package_Of
753 (Node
: Project_Node_Id
;
754 In_Tree
: Project_Node_Tree_Ref
;
755 To
: Project_Node_Id
);
756 pragma Inline
(Set_Project_Of_Renamed_Package_Of
);
758 procedure Set_Next_Package_In_Project
759 (Node
: Project_Node_Id
;
760 In_Tree
: Project_Node_Tree_Ref
;
761 To
: Project_Node_Id
);
762 pragma Inline
(Set_Next_Package_In_Project
);
764 procedure Set_First_Literal_String
765 (Node
: Project_Node_Id
;
766 In_Tree
: Project_Node_Tree_Ref
;
767 To
: Project_Node_Id
);
768 pragma Inline
(Set_First_Literal_String
);
770 procedure Set_Next_String_Type
771 (Node
: Project_Node_Id
;
772 In_Tree
: Project_Node_Tree_Ref
;
773 To
: Project_Node_Id
);
774 pragma Inline
(Set_Next_String_Type
);
776 procedure Set_Next_Literal_String
777 (Node
: Project_Node_Id
;
778 In_Tree
: Project_Node_Tree_Ref
;
779 To
: Project_Node_Id
);
780 pragma Inline
(Set_Next_Literal_String
);
782 procedure Set_Expression_Of
783 (Node
: Project_Node_Id
;
784 In_Tree
: Project_Node_Tree_Ref
;
785 To
: Project_Node_Id
);
786 pragma Inline
(Set_Expression_Of
);
788 procedure Set_Associative_Project_Of
789 (Node
: Project_Node_Id
;
790 In_Tree
: Project_Node_Tree_Ref
;
791 To
: Project_Node_Id
);
792 pragma Inline
(Set_Associative_Project_Of
);
794 procedure Set_Associative_Package_Of
795 (Node
: Project_Node_Id
;
796 In_Tree
: Project_Node_Tree_Ref
;
797 To
: Project_Node_Id
);
798 pragma Inline
(Set_Associative_Package_Of
);
800 procedure Set_Associative_Array_Index_Of
801 (Node
: Project_Node_Id
;
802 In_Tree
: Project_Node_Tree_Ref
;
804 pragma Inline
(Set_Associative_Array_Index_Of
);
806 procedure Set_Next_Variable
807 (Node
: Project_Node_Id
;
808 In_Tree
: Project_Node_Tree_Ref
;
809 To
: Project_Node_Id
);
810 pragma Inline
(Set_Next_Variable
);
812 procedure Set_First_Term
813 (Node
: Project_Node_Id
;
814 In_Tree
: Project_Node_Tree_Ref
;
815 To
: Project_Node_Id
);
816 pragma Inline
(Set_First_Term
);
818 procedure Set_Next_Expression_In_List
819 (Node
: Project_Node_Id
;
820 In_Tree
: Project_Node_Tree_Ref
;
821 To
: Project_Node_Id
);
822 pragma Inline
(Set_Next_Expression_In_List
);
824 procedure Set_Current_Term
825 (Node
: Project_Node_Id
;
826 In_Tree
: Project_Node_Tree_Ref
;
827 To
: Project_Node_Id
);
828 pragma Inline
(Set_Current_Term
);
830 procedure Set_Next_Term
831 (Node
: Project_Node_Id
;
832 In_Tree
: Project_Node_Tree_Ref
;
833 To
: Project_Node_Id
);
834 pragma Inline
(Set_Next_Term
);
836 procedure Set_First_Expression_In_List
837 (Node
: Project_Node_Id
;
838 In_Tree
: Project_Node_Tree_Ref
;
839 To
: Project_Node_Id
);
840 pragma Inline
(Set_First_Expression_In_List
);
842 procedure Set_Package_Node_Of
843 (Node
: Project_Node_Id
;
844 In_Tree
: Project_Node_Tree_Ref
;
845 To
: Project_Node_Id
);
846 pragma Inline
(Set_Package_Node_Of
);
848 procedure Set_Source_Index_Of
849 (Node
: Project_Node_Id
;
850 In_Tree
: Project_Node_Tree_Ref
;
852 pragma Inline
(Set_Source_Index_Of
);
854 procedure Set_String_Type_Of
855 (Node
: Project_Node_Id
;
856 In_Tree
: Project_Node_Tree_Ref
;
857 To
: Project_Node_Id
);
858 pragma Inline
(Set_String_Type_Of
);
860 procedure Set_External_Reference_Of
861 (Node
: Project_Node_Id
;
862 In_Tree
: Project_Node_Tree_Ref
;
863 To
: Project_Node_Id
);
864 pragma Inline
(Set_External_Reference_Of
);
866 procedure Set_External_Default_Of
867 (Node
: Project_Node_Id
;
868 In_Tree
: Project_Node_Tree_Ref
;
869 To
: Project_Node_Id
);
870 pragma Inline
(Set_External_Default_Of
);
872 procedure Set_Case_Variable_Reference_Of
873 (Node
: Project_Node_Id
;
874 In_Tree
: Project_Node_Tree_Ref
;
875 To
: Project_Node_Id
);
876 pragma Inline
(Set_Case_Variable_Reference_Of
);
878 procedure Set_First_Case_Item_Of
879 (Node
: Project_Node_Id
;
880 In_Tree
: Project_Node_Tree_Ref
;
881 To
: Project_Node_Id
);
882 pragma Inline
(Set_First_Case_Item_Of
);
884 procedure Set_First_Choice_Of
885 (Node
: Project_Node_Id
;
886 In_Tree
: Project_Node_Tree_Ref
;
887 To
: Project_Node_Id
);
888 pragma Inline
(Set_First_Choice_Of
);
890 procedure Set_Next_Case_Item
891 (Node
: Project_Node_Id
;
892 In_Tree
: Project_Node_Tree_Ref
;
893 To
: Project_Node_Id
);
894 pragma Inline
(Set_Next_Case_Item
);
896 procedure Set_Case_Insensitive
897 (Node
: Project_Node_Id
;
898 In_Tree
: Project_Node_Tree_Ref
;
901 -------------------------------
902 -- Restricted Access Section --
903 -------------------------------
905 package Tree_Private_Part
is
907 -- This is conceptually in the private part
909 -- However, for efficiency, some packages are accessing it directly
911 type Project_Node_Record
is record
913 Kind
: Project_Node_Kind
;
915 Location
: Source_Ptr
:= No_Location
;
917 Directory
: Path_Name_Type
:= No_Path
;
918 -- Only for N_Project
920 Expr_Kind
: Variable_Kind
:= Undefined
;
921 -- See below for what Project_Node_Kind it is used
923 Variables
: Variable_Node_Id
:= Empty_Node
;
924 -- First variable in a project or a package
926 Packages
: Package_Declaration_Id
:= Empty_Node
;
927 -- First package declaration in a project
929 Pkg_Id
: Package_Node_Id
:= Empty_Package
;
930 -- Only used for N_Package_Declaration
931 -- The component Pkg_Id is an entry into the table Package_Attributes
932 -- (in Prj.Attr). It is used to indicate all the attributes of the
933 -- package with their characteristics.
935 -- The tables Prj.Attr.Attributes and Prj.Attr.Package_Attributes
936 -- are built once and for all through a call (from Prj.Initialize)
937 -- to procedure Prj.Attr.Initialize. It is never modified after that.
939 Name
: Name_Id
:= No_Name
;
940 -- See below for what Project_Node_Kind it is used
942 Src_Index
: Int
:= 0;
943 -- Index of a unit in a multi-unit source.
944 -- Onli for some N_Attribute_Declaration and N_Literal_String.
946 Path_Name
: Path_Name_Type
:= No_Path
;
947 -- See below for what Project_Node_Kind it is used
949 Value
: Name_Id
:= No_Name
;
950 -- See below for what Project_Node_Kind it is used
952 Field1
: Project_Node_Id
:= Empty_Node
;
953 -- See below the meaning for each Project_Node_Kind
955 Field2
: Project_Node_Id
:= Empty_Node
;
956 -- See below the meaning for each Project_Node_Kind
958 Field3
: Project_Node_Id
:= Empty_Node
;
959 -- See below the meaning for each Project_Node_Kind
961 Flag1
: Boolean := False;
962 -- This flag is significant only for:
963 -- N_Attribute_Declaration and N_Atribute_Reference
964 -- It indicates for an associative array attribute, that the
965 -- index is case insensitive.
966 -- N_Comment - it indicates that the comment is preceded by an
968 -- N_Project - it indicates that there are comments in the project
969 -- source that cannot be kept in the tree.
970 -- N_Project_Declaration
971 -- - it indicates that there are unkept comments in the
974 -- - it indicates that this is not the last with in a
975 -- with clause. It is set for "A", but not for "B" in
980 Flag2
: Boolean := False;
981 -- This flag is significant only for:
982 -- N_Project - it indicates that the project "extends all" another
984 -- N_Comment - it indicates that the comment is followed by an
987 -- - it indicates that the originally imported project
988 -- is an extending all project.
990 Comments
: Project_Node_Id
:= Empty_Node
;
991 -- For nodes other that N_Comment_Zones or N_Comment, designates the
992 -- comment zones associated with the node.
993 -- for N_Comment_Zones, designates the comment after the "end" of
995 -- For N_Comment, designates the next comment, if any.
999 -- type Project_Node_Kind is
1002 -- -- Name: project name
1003 -- -- Path_Name: project path name
1004 -- -- Expr_Kind: Undefined
1005 -- -- Field1: first with clause
1006 -- -- Field2: project declaration
1007 -- -- Field3: first string type
1008 -- -- Value: extended project path name (if any)
1011 -- -- Name: imported project name
1012 -- -- Path_Name: imported project path name
1013 -- -- Expr_Kind: Undefined
1014 -- -- Field1: project node
1015 -- -- Field2: next with clause
1016 -- -- Field3: project node or empty if "limited with"
1017 -- -- Value: literal string withed
1019 -- N_Project_Declaration,
1020 -- -- Name: not used
1021 -- -- Path_Name: not used
1022 -- -- Expr_Kind: Undefined
1023 -- -- Field1: first declarative item
1024 -- -- Field2: extended project
1025 -- -- Field3: extending project
1026 -- -- Value: not used
1028 -- N_Declarative_Item,
1029 -- -- Name: not used
1030 -- -- Path_Name: not used
1031 -- -- Expr_Kind: Undefined
1032 -- -- Field1: current item node
1033 -- -- Field2: next declarative item
1034 -- -- Field3: not used
1035 -- -- Value: not used
1037 -- N_Package_Declaration,
1038 -- -- Name: package name
1039 -- -- Path_Name: not used
1040 -- -- Expr_Kind: Undefined
1041 -- -- Field1: project of renamed package (if any)
1042 -- -- Field2: first declarative item
1043 -- -- Field3: next package in project
1044 -- -- Value: not used
1046 -- N_String_Type_Declaration,
1047 -- -- Name: type name
1048 -- -- Path_Name: not used
1049 -- -- Expr_Kind: Undefined
1050 -- -- Field1: first literal string
1051 -- -- Field2: next string type
1052 -- -- Field3: not used
1053 -- -- Value: not used
1055 -- N_Literal_String,
1056 -- -- Name: not used
1057 -- -- Path_Name: not used
1058 -- -- Expr_Kind: Single
1059 -- -- Field1: next literal string
1060 -- -- Field2: not used
1061 -- -- Field3: not used
1062 -- -- Value: string value
1064 -- N_Attribute_Declaration,
1065 -- -- Name: attribute name
1066 -- -- Path_Name: not used
1067 -- -- Expr_Kind: attribute kind
1068 -- -- Field1: expression
1069 -- -- Field2: project of full associative array
1070 -- -- Field3: package of full associative array
1071 -- -- Value: associative array index
1072 -- -- (if an associative array element)
1074 -- N_Typed_Variable_Declaration,
1075 -- -- Name: variable name
1076 -- -- Path_Name: not used
1077 -- -- Expr_Kind: Single
1078 -- -- Field1: expression
1079 -- -- Field2: type of variable (N_String_Type_Declaration)
1080 -- -- Field3: next variable
1081 -- -- Value: not used
1083 -- N_Variable_Declaration,
1084 -- -- Name: variable name
1085 -- -- Path_Name: not used
1086 -- -- Expr_Kind: variable kind
1087 -- -- Field1: expression
1088 -- -- Field2: not used
1089 -- -- Field3 is used for next variable, instead of Field2,
1090 -- -- so that it is the same field for
1091 -- -- N_Variable_Declaration and
1092 -- -- N_Typed_Variable_Declaration
1093 -- -- Field3: next variable
1094 -- -- Value: not used
1097 -- -- Name: not used
1098 -- -- Path_Name: not used
1099 -- -- Expr_Kind: expression kind
1100 -- -- Field1: first term
1101 -- -- Field2: next expression in list
1102 -- -- Field3: not used
1103 -- -- Value: not used
1106 -- -- Name: not used
1107 -- -- Path_Name: not used
1108 -- -- Expr_Kind: term kind
1109 -- -- Field1: current term
1110 -- -- Field2: next term in the expression
1111 -- -- Field3: not used
1112 -- -- Value: not used
1114 -- N_Literal_String_List,
1115 -- -- Designates a list of string expressions between brackets
1116 -- -- separated by commas. The string expressions are not necessarily
1117 -- -- literal strings.
1118 -- -- Name: not used
1119 -- -- Path_Name: not used
1120 -- -- Expr_Kind: List
1121 -- -- Field1: first expression
1122 -- -- Field2: not used
1123 -- -- Field3: not used
1124 -- -- Value: not used
1126 -- N_Variable_Reference,
1127 -- -- Name: variable name
1128 -- -- Path_Name: not used
1129 -- -- Expr_Kind: variable kind
1130 -- -- Field1: project (if specified)
1131 -- -- Field2: package (if specified)
1132 -- -- Field3: type of variable (N_String_Type_Declaration), if any
1133 -- -- Value: not used
1135 -- N_External_Value,
1136 -- -- Name: not used
1137 -- -- Path_Name: not used
1138 -- -- Expr_Kind: Single
1139 -- -- Field1: Name of the external reference (literal string)
1140 -- -- Field2: Default (literal string)
1141 -- -- Field3: not used
1142 -- -- Value: not used
1144 -- N_Attribute_Reference,
1145 -- -- Name: attribute name
1146 -- -- Path_Name: not used
1147 -- -- Expr_Kind: attribute kind
1148 -- -- Field1: project
1149 -- -- Field2: package (if attribute of a package)
1150 -- -- Field3: not used
1151 -- -- Value: associative array index
1152 -- -- (if an associative array element)
1154 -- N_Case_Construction,
1155 -- -- Name: not used
1156 -- -- Path_Name: not used
1157 -- -- Expr_Kind: Undefined
1158 -- -- Field1: case variable reference
1159 -- -- Field2: first case item
1160 -- -- Field3: not used
1161 -- -- Value: not used
1164 -- -- Name: not used
1165 -- -- Path_Name: not used
1166 -- -- Expr_Kind: not used
1167 -- -- Field1: first choice (literal string), or Empty_Node
1168 -- -- for when others
1169 -- -- Field2: first declarative item
1170 -- -- Field3: next case item
1171 -- -- Value: not used
1174 -- -- Name: not used
1175 -- -- Path_Name: not used
1176 -- -- Expr_Kind: not used
1177 -- -- Field1: comment before the construct
1178 -- -- Field2: comment after the construct
1179 -- -- Field3: comment before the "end" of the construct
1180 -- -- Value: end of line comment
1181 -- -- Comments: comment after the "end" of the construct
1184 -- -- Name: not used
1185 -- -- Path_Name: not used
1186 -- -- Expr_Kind: not used
1187 -- -- Field1: not used
1188 -- -- Field2: not used
1189 -- -- Field3: not used
1190 -- -- Value: comment
1191 -- -- Flag1: comment is preceded by an empty line
1192 -- -- Flag2: comment is followed by an empty line
1193 -- -- Comments: next comment
1195 package Project_Node_Table
is
1196 new GNAT
.Dynamic_Tables
1197 (Table_Component_Type
=> Project_Node_Record
,
1198 Table_Index_Type
=> Project_Node_Id
,
1199 Table_Low_Bound
=> First_Node_Id
,
1200 Table_Initial
=> Project_Nodes_Initial
,
1201 Table_Increment
=> Project_Nodes_Increment
);
1202 -- This table contains the syntactic tree of project data
1203 -- from project files.
1205 type Project_Name_And_Node
is record
1207 -- Name of the project
1209 Node
: Project_Node_Id
;
1210 -- Node of the project in table Project_Nodes
1212 Canonical_Path
: Path_Name_Type
;
1213 -- Resolved and canonical path of a real project file.
1214 -- No_Name in case of virtual projects.
1217 -- True when the project is being extended by another project
1220 No_Project_Name_And_Node
: constant Project_Name_And_Node
:=
1223 Canonical_Path
=> No_Path
,
1226 package Projects_Htable
is new GNAT
.Dynamic_HTables
.Simple_HTable
1227 (Header_Num
=> Header_Num
,
1228 Element
=> Project_Name_And_Node
,
1229 No_Element
=> No_Project_Name_And_Node
,
1233 -- This hash table contains a mapping of project names to project nodes.
1234 -- Note that this hash table contains only the nodes whose Kind is
1235 -- N_Project. It is used to find the node of a project from its name,
1236 -- and to verify if a project has already been parsed, knowing its name.
1238 end Tree_Private_Part
;
1240 type Project_Node_Tree_Data
is record
1241 Project_Nodes
: Tree_Private_Part
.Project_Node_Table
.Instance
;
1242 Projects_HT
: Tree_Private_Part
.Projects_Htable
.Instance
;
1244 -- The data for a project node tree
1247 type Comment_Array
is array (Positive range <>) of Comment_Data
;
1248 type Comments_Ptr
is access Comment_Array
;
1250 type Comment_State
is record
1251 End_Of_Line_Node
: Project_Node_Id
:= Empty_Node
;
1253 Previous_Line_Node
: Project_Node_Id
:= Empty_Node
;
1255 Previous_End_Node
: Project_Node_Id
:= Empty_Node
;
1257 Unkept_Comments
: Boolean := False;
1259 Comments
: Comments_Ptr
:= null;