projects / gcc.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
[multiple changes]
[gcc.git] / gcc / ada / prj-tree.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . T R E E --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
10 -- --
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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
21 -- --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
25 ------------------------------------------------------------------------------
26
27 package body Prj.Tree is
28
29 use Tree_Private_Part;
30
31 --------------------------------
32 -- Associative_Array_Index_Of --
33 --------------------------------
34
35 function Associative_Array_Index_Of
36 (Node : Project_Node_Id)
37 return Name_Id
38 is
39 begin
40 pragma Assert
41 (Node /= Empty_Node
42 and then
43 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
44 or else
45 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
46 return Project_Nodes.Table (Node).Value;
47 end Associative_Array_Index_Of;
48
49 ----------------------------
50 -- Associative_Package_Of --
51 ----------------------------
52
53 function Associative_Package_Of
54 (Node : Project_Node_Id)
55 return Project_Node_Id
56 is
57 begin
58 pragma Assert
59 (Node /= Empty_Node
60 and then
61 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
62 return Project_Nodes.Table (Node).Field3;
63 end Associative_Package_Of;
64
65 ----------------------------
66 -- Associative_Project_Of --
67 ----------------------------
68
69 function Associative_Project_Of
70 (Node : Project_Node_Id)
71 return Project_Node_Id
72 is
73 begin
74 pragma Assert
75 (Node /= Empty_Node
76 and then
77 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
78 return Project_Nodes.Table (Node).Field2;
79 end Associative_Project_Of;
80
81 ----------------------
82 -- Case_Insensitive --
83 ----------------------
84
85 function Case_Insensitive (Node : Project_Node_Id) return Boolean is
86 begin
87 pragma Assert
88 (Node /= Empty_Node
89 and then
90 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
91 or else
92 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
93 return Project_Nodes.Table (Node).Case_Insensitive;
94 end Case_Insensitive;
95
96 --------------------------------
97 -- Case_Variable_Reference_Of --
98 --------------------------------
99
100 function Case_Variable_Reference_Of
101 (Node : Project_Node_Id)
102 return Project_Node_Id
103 is
104 begin
105 pragma Assert
106 (Node /= Empty_Node
107 and then
108 Project_Nodes.Table (Node).Kind = N_Case_Construction);
109 return Project_Nodes.Table (Node).Field1;
110 end Case_Variable_Reference_Of;
111
112 -----------------------
113 -- Current_Item_Node --
114 -----------------------
115
116 function Current_Item_Node
117 (Node : Project_Node_Id)
118 return Project_Node_Id
119 is
120 begin
121 pragma Assert
122 (Node /= Empty_Node
123 and then
124 Project_Nodes.Table (Node).Kind = N_Declarative_Item);
125 return Project_Nodes.Table (Node).Field1;
126 end Current_Item_Node;
127
128 ------------------
129 -- Current_Term --
130 ------------------
131
132 function Current_Term
133 (Node : Project_Node_Id)
134 return Project_Node_Id
135 is
136 begin
137 pragma Assert
138 (Node /= Empty_Node
139 and then
140 Project_Nodes.Table (Node).Kind = N_Term);
141 return Project_Nodes.Table (Node).Field1;
142 end Current_Term;
143
144 --------------------------
145 -- Default_Project_Node --
146 --------------------------
147
148 function Default_Project_Node
149 (Of_Kind : Project_Node_Kind;
150 And_Expr_Kind : Variable_Kind := Undefined)
151 return Project_Node_Id
152 is
153 begin
154 Project_Nodes.Increment_Last;
155 Project_Nodes.Table (Project_Nodes.Last) :=
156 (Kind => Of_Kind,
157 Location => No_Location,
158 Directory => No_Name,
159 Expr_Kind => And_Expr_Kind,
160 Variables => Empty_Node,
161 Packages => Empty_Node,
162 Pkg_Id => Empty_Package,
163 Name => No_Name,
164 Path_Name => No_Name,
165 Value => No_Name,
166 Field1 => Empty_Node,
167 Field2 => Empty_Node,
168 Field3 => Empty_Node,
169 Case_Insensitive => False,
170 Extending_All => False);
171 return Project_Nodes.Last;
172 end Default_Project_Node;
173
174 ------------------
175 -- Directory_Of --
176 ------------------
177
178 function Directory_Of (Node : Project_Node_Id) return Name_Id is
179 begin
180 pragma Assert
181 (Node /= Empty_Node
182 and then
183 Project_Nodes.Table (Node).Kind = N_Project);
184 return Project_Nodes.Table (Node).Directory;
185 end Directory_Of;
186
187 ------------------------
188 -- Expression_Kind_Of --
189 ------------------------
190
191 function Expression_Kind_Of (Node : Project_Node_Id) return Variable_Kind is
192 begin
193 pragma Assert
194 (Node /= Empty_Node
195 and then
196 (Project_Nodes.Table (Node).Kind = N_Literal_String
197 or else
198 Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
199 or else
200 Project_Nodes.Table (Node).Kind = N_Variable_Declaration
201 or else
202 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
203 or else
204 Project_Nodes.Table (Node).Kind = N_Package_Declaration
205 or else
206 Project_Nodes.Table (Node).Kind = N_Expression
207 or else
208 Project_Nodes.Table (Node).Kind = N_Term
209 or else
210 Project_Nodes.Table (Node).Kind = N_Variable_Reference
211 or else
212 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
213
214 return Project_Nodes.Table (Node).Expr_Kind;
215 end Expression_Kind_Of;
216
217 -------------------
218 -- Expression_Of --
219 -------------------
220
221 function Expression_Of
222 (Node : Project_Node_Id)
223 return Project_Node_Id
224 is
225 begin
226 pragma Assert
227 (Node /= Empty_Node
228 and then
229 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
230 or else
231 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
232 or else
233 Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
234
235 return Project_Nodes.Table (Node).Field1;
236 end Expression_Of;
237
238 -------------------------
239 -- Extended_Project_Of --
240 -------------------------
241
242 function Extended_Project_Of
243 (Node : Project_Node_Id)
244 return Project_Node_Id
245 is
246 begin
247 pragma Assert
248 (Node /= Empty_Node
249 and then
250 Project_Nodes.Table (Node).Kind = N_Project_Declaration);
251 return Project_Nodes.Table (Node).Field2;
252 end Extended_Project_Of;
253
254 ------------------------------
255 -- Extended_Project_Path_Of --
256 ------------------------------
257
258 function Extended_Project_Path_Of
259 (Node : Project_Node_Id)
260 return Name_Id
261 is
262 begin
263 pragma Assert
264 (Node /= Empty_Node
265 and then
266 Project_Nodes.Table (Node).Kind = N_Project);
267 return Project_Nodes.Table (Node).Value;
268 end Extended_Project_Path_Of;
269
270 --------------------------
271 -- Extending_Project_Of --
272 --------------------------
273 function Extending_Project_Of
274 (Node : Project_Node_Id)
275 return Project_Node_Id
276 is
277 begin
278 pragma Assert
279 (Node /= Empty_Node
280 and then
281 Project_Nodes.Table (Node).Kind = N_Project_Declaration);
282 return Project_Nodes.Table (Node).Field3;
283 end Extending_Project_Of;
284
285 ---------------------------
286 -- External_Reference_Of --
287 ---------------------------
288
289 function External_Reference_Of
290 (Node : Project_Node_Id)
291 return Project_Node_Id
292 is
293 begin
294 pragma Assert
295 (Node /= Empty_Node
296 and then
297 Project_Nodes.Table (Node).Kind = N_External_Value);
298 return Project_Nodes.Table (Node).Field1;
299 end External_Reference_Of;
300
301 -------------------------
302 -- External_Default_Of --
303 -------------------------
304
305 function External_Default_Of
306 (Node : Project_Node_Id)
307 return Project_Node_Id
308 is
309 begin
310 pragma Assert
311 (Node /= Empty_Node
312 and then
313 Project_Nodes.Table (Node).Kind = N_External_Value);
314 return Project_Nodes.Table (Node).Field2;
315 end External_Default_Of;
316
317 ------------------------
318 -- First_Case_Item_Of --
319 ------------------------
320
321 function First_Case_Item_Of
322 (Node : Project_Node_Id)
323 return Project_Node_Id
324 is
325 begin
326 pragma Assert
327 (Node /= Empty_Node
328 and then
329 Project_Nodes.Table (Node).Kind = N_Case_Construction);
330 return Project_Nodes.Table (Node).Field2;
331 end First_Case_Item_Of;
332
333 ---------------------
334 -- First_Choice_Of --
335 ---------------------
336
337 function First_Choice_Of
338 (Node : Project_Node_Id)
339 return Project_Node_Id
340 is
341 begin
342 pragma Assert
343 (Node /= Empty_Node
344 and then
345 Project_Nodes.Table (Node).Kind = N_Case_Item);
346 return Project_Nodes.Table (Node).Field1;
347 end First_Choice_Of;
348
349 -------------------------------
350 -- First_Declarative_Item_Of --
351 -------------------------------
352
353 function First_Declarative_Item_Of
354 (Node : Project_Node_Id)
355 return Project_Node_Id
356 is
357 begin
358 pragma Assert
359 (Node /= Empty_Node
360 and then
361 (Project_Nodes.Table (Node).Kind = N_Project_Declaration
362 or else
363 Project_Nodes.Table (Node).Kind = N_Case_Item
364 or else
365 Project_Nodes.Table (Node).Kind = N_Package_Declaration));
366
367 if Project_Nodes.Table (Node).Kind = N_Project_Declaration then
368 return Project_Nodes.Table (Node).Field1;
369 else
370 return Project_Nodes.Table (Node).Field2;
371 end if;
372 end First_Declarative_Item_Of;
373
374 ------------------------------
375 -- First_Expression_In_List --
376 ------------------------------
377
378 function First_Expression_In_List
379 (Node : Project_Node_Id)
380 return Project_Node_Id
381 is
382 begin
383 pragma Assert
384 (Node /= Empty_Node
385 and then
386 Project_Nodes.Table (Node).Kind = N_Literal_String_List);
387 return Project_Nodes.Table (Node).Field1;
388 end First_Expression_In_List;
389
390 --------------------------
391 -- First_Literal_String --
392 --------------------------
393
394 function First_Literal_String
395 (Node : Project_Node_Id)
396 return Project_Node_Id
397 is
398 begin
399 pragma Assert
400 (Node /= Empty_Node
401 and then
402 Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
403 return Project_Nodes.Table (Node).Field1;
404 end First_Literal_String;
405
406 ----------------------
407 -- First_Package_Of --
408 ----------------------
409
410 function First_Package_Of
411 (Node : Project_Node_Id)
412 return Package_Declaration_Id
413 is
414 begin
415 pragma Assert
416 (Node /= Empty_Node
417 and then
418 Project_Nodes.Table (Node).Kind = N_Project);
419 return Project_Nodes.Table (Node).Packages;
420 end First_Package_Of;
421
422 --------------------------
423 -- First_String_Type_Of --
424 --------------------------
425
426 function First_String_Type_Of
427 (Node : Project_Node_Id)
428 return Project_Node_Id
429 is
430 begin
431 pragma Assert
432 (Node /= Empty_Node
433 and then
434 Project_Nodes.Table (Node).Kind = N_Project);
435 return Project_Nodes.Table (Node).Field3;
436 end First_String_Type_Of;
437
438 ----------------
439 -- First_Term --
440 ----------------
441
442 function First_Term
443 (Node : Project_Node_Id)
444 return Project_Node_Id
445 is
446 begin
447 pragma Assert
448 (Node /= Empty_Node
449 and then
450 Project_Nodes.Table (Node).Kind = N_Expression);
451 return Project_Nodes.Table (Node).Field1;
452 end First_Term;
453
454 -----------------------
455 -- First_Variable_Of --
456 -----------------------
457
458 function First_Variable_Of
459 (Node : Project_Node_Id)
460 return Variable_Node_Id
461 is
462 begin
463 pragma Assert
464 (Node /= Empty_Node
465 and then
466 (Project_Nodes.Table (Node).Kind = N_Project
467 or else
468 Project_Nodes.Table (Node).Kind = N_Package_Declaration));
469
470 return Project_Nodes.Table (Node).Variables;
471 end First_Variable_Of;
472
473 --------------------------
474 -- First_With_Clause_Of --
475 --------------------------
476
477 function First_With_Clause_Of
478 (Node : Project_Node_Id)
479 return Project_Node_Id
480 is
481 begin
482 pragma Assert
483 (Node /= Empty_Node
484 and then
485 Project_Nodes.Table (Node).Kind = N_Project);
486 return Project_Nodes.Table (Node).Field1;
487 end First_With_Clause_Of;
488
489 ----------------------
490 -- Is_Extending_All --
491 ----------------------
492
493 function Is_Extending_All (Node : Project_Node_Id) return Boolean is
494 begin
495 pragma Assert
496 (Node /= Empty_Node
497 and then
498 Project_Nodes.Table (Node).Kind = N_Project);
499 return Project_Nodes.Table (Node).Extending_All;
500 end Is_Extending_All;
501
502 ----------
503 -- Hash --
504 ----------
505
506 function Hash (N : Project_Node_Id) return Header_Num is
507 begin
508 return Header_Num (N mod Project_Node_Id (Header_Num'Last));
509 end Hash;
510
511 -------------------------------------
512 -- Imported_Or_Extended_Project_Of --
513 -------------------------------------
514
515 function Imported_Or_Extended_Project_Of
516 (Project : Project_Node_Id;
517 With_Name : Name_Id)
518 return Project_Node_Id
519 is
520 With_Clause : Project_Node_Id := First_With_Clause_Of (Project);
521 Result : Project_Node_Id := Empty_Node;
522
523 begin
524 -- First check all the imported projects
525
526 while With_Clause /= Empty_Node loop
527
528 -- Only non limited imported project may be used as prefix
529 -- of variable or attributes.
530
531 Result := Non_Limited_Project_Node_Of (With_Clause);
532 exit when Result /= Empty_Node and then Name_Of (Result) = With_Name;
533 With_Clause := Next_With_Clause_Of (With_Clause);
534 end loop;
535
536 -- If it is not an imported project, it might be the imported project
537
538 if With_Clause = Empty_Node then
539 Result := Extended_Project_Of (Project_Declaration_Of (Project));
540
541 if Result /= Empty_Node
542 and then Name_Of (Result) /= With_Name
543 then
544 Result := Empty_Node;
545 end if;
546 end if;
547
548 return Result;
549 end Imported_Or_Extended_Project_Of;
550
551 ----------------
552 -- Initialize --
553 ----------------
554
555 procedure Initialize is
556 begin
557 Project_Nodes.Set_Last (Empty_Node);
558 Projects_Htable.Reset;
559 end Initialize;
560
561 -------------
562 -- Kind_Of --
563 -------------
564
565 function Kind_Of (Node : Project_Node_Id) return Project_Node_Kind is
566 begin
567 pragma Assert (Node /= Empty_Node);
568 return Project_Nodes.Table (Node).Kind;
569 end Kind_Of;
570
571 -----------------
572 -- Location_Of --
573 -----------------
574
575 function Location_Of (Node : Project_Node_Id) return Source_Ptr is
576 begin
577 pragma Assert (Node /= Empty_Node);
578 return Project_Nodes.Table (Node).Location;
579 end Location_Of;
580
581 -------------
582 -- Name_Of --
583 -------------
584
585 function Name_Of (Node : Project_Node_Id) return Name_Id is
586 begin
587 pragma Assert (Node /= Empty_Node);
588 return Project_Nodes.Table (Node).Name;
589 end Name_Of;
590
591 --------------------
592 -- Next_Case_Item --
593 --------------------
594
595 function Next_Case_Item
596 (Node : Project_Node_Id)
597 return Project_Node_Id
598 is
599 begin
600 pragma Assert
601 (Node /= Empty_Node
602 and then
603 Project_Nodes.Table (Node).Kind = N_Case_Item);
604 return Project_Nodes.Table (Node).Field3;
605 end Next_Case_Item;
606
607 ---------------------------
608 -- Next_Declarative_Item --
609 ---------------------------
610
611 function Next_Declarative_Item
612 (Node : Project_Node_Id)
613 return Project_Node_Id
614 is
615 begin
616 pragma Assert
617 (Node /= Empty_Node
618 and then
619 Project_Nodes.Table (Node).Kind = N_Declarative_Item);
620 return Project_Nodes.Table (Node).Field2;
621 end Next_Declarative_Item;
622
623 -----------------------------
624 -- Next_Expression_In_List --
625 -----------------------------
626
627 function Next_Expression_In_List
628 (Node : Project_Node_Id)
629 return Project_Node_Id
630 is
631 begin
632 pragma Assert
633 (Node /= Empty_Node
634 and then
635 Project_Nodes.Table (Node).Kind = N_Expression);
636 return Project_Nodes.Table (Node).Field2;
637 end Next_Expression_In_List;
638
639 -------------------------
640 -- Next_Literal_String --
641 -------------------------
642
643 function Next_Literal_String
644 (Node : Project_Node_Id)
645 return Project_Node_Id
646 is
647 begin
648 pragma Assert
649 (Node /= Empty_Node
650 and then
651 Project_Nodes.Table (Node).Kind = N_Literal_String);
652 return Project_Nodes.Table (Node).Field1;
653 end Next_Literal_String;
654
655 -----------------------------
656 -- Next_Package_In_Project --
657 -----------------------------
658
659 function Next_Package_In_Project
660 (Node : Project_Node_Id)
661 return Project_Node_Id
662 is
663 begin
664 pragma Assert
665 (Node /= Empty_Node
666 and then
667 Project_Nodes.Table (Node).Kind = N_Package_Declaration);
668 return Project_Nodes.Table (Node).Field3;
669 end Next_Package_In_Project;
670
671 ----------------------
672 -- Next_String_Type --
673 ----------------------
674
675 function Next_String_Type
676 (Node : Project_Node_Id)
677 return Project_Node_Id
678 is
679 begin
680 pragma Assert
681 (Node /= Empty_Node
682 and then
683 Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
684 return Project_Nodes.Table (Node).Field2;
685 end Next_String_Type;
686
687 ---------------
688 -- Next_Term --
689 ---------------
690
691 function Next_Term
692 (Node : Project_Node_Id)
693 return Project_Node_Id
694 is
695 begin
696 pragma Assert
697 (Node /= Empty_Node
698 and then
699 Project_Nodes.Table (Node).Kind = N_Term);
700 return Project_Nodes.Table (Node).Field2;
701 end Next_Term;
702
703 -------------------
704 -- Next_Variable --
705 -------------------
706
707 function Next_Variable
708 (Node : Project_Node_Id)
709 return Project_Node_Id
710 is
711 begin
712 pragma Assert
713 (Node /= Empty_Node
714 and then
715 (Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
716 or else
717 Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
718
719 return Project_Nodes.Table (Node).Field3;
720 end Next_Variable;
721
722 -------------------------
723 -- Next_With_Clause_Of --
724 -------------------------
725
726 function Next_With_Clause_Of
727 (Node : Project_Node_Id)
728 return Project_Node_Id
729 is
730 begin
731 pragma Assert
732 (Node /= Empty_Node
733 and then
734 Project_Nodes.Table (Node).Kind = N_With_Clause);
735 return Project_Nodes.Table (Node).Field2;
736 end Next_With_Clause_Of;
737
738 ---------------------------------
739 -- Non_Limited_Project_Node_Of --
740 ---------------------------------
741
742 function Non_Limited_Project_Node_Of
743 (Node : Project_Node_Id)
744 return Project_Node_Id
745 is
746 begin
747 pragma Assert
748 (Node /= Empty_Node
749 and then
750 (Project_Nodes.Table (Node).Kind = N_With_Clause));
751 return Project_Nodes.Table (Node).Field3;
752 end Non_Limited_Project_Node_Of;
753 -------------------
754 -- Package_Id_Of --
755 -------------------
756
757 function Package_Id_Of (Node : Project_Node_Id) return Package_Node_Id is
758 begin
759 pragma Assert
760 (Node /= Empty_Node
761 and then
762 Project_Nodes.Table (Node).Kind = N_Package_Declaration);
763 return Project_Nodes.Table (Node).Pkg_Id;
764 end Package_Id_Of;
765
766 ---------------------
767 -- Package_Node_Of --
768 ---------------------
769
770 function Package_Node_Of
771 (Node : Project_Node_Id)
772 return Project_Node_Id
773 is
774 begin
775 pragma Assert
776 (Node /= Empty_Node
777 and then
778 (Project_Nodes.Table (Node).Kind = N_Variable_Reference
779 or else
780 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
781 return Project_Nodes.Table (Node).Field2;
782 end Package_Node_Of;
783
784 ------------------
785 -- Path_Name_Of --
786 ------------------
787
788 function Path_Name_Of (Node : Project_Node_Id) return Name_Id is
789 begin
790 pragma Assert
791 (Node /= Empty_Node
792 and then
793 (Project_Nodes.Table (Node).Kind = N_Project
794 or else
795 Project_Nodes.Table (Node).Kind = N_With_Clause));
796 return Project_Nodes.Table (Node).Path_Name;
797 end Path_Name_Of;
798
799 ----------------------------
800 -- Project_Declaration_Of --
801 ----------------------------
802
803 function Project_Declaration_Of
804 (Node : Project_Node_Id)
805 return Project_Node_Id
806 is
807 begin
808 pragma Assert
809 (Node /= Empty_Node
810 and then
811 Project_Nodes.Table (Node).Kind = N_Project);
812 return Project_Nodes.Table (Node).Field2;
813 end Project_Declaration_Of;
814
815 ---------------------
816 -- Project_Node_Of --
817 ---------------------
818
819 function Project_Node_Of
820 (Node : Project_Node_Id)
821 return Project_Node_Id
822 is
823 begin
824 pragma Assert
825 (Node /= Empty_Node
826 and then
827 (Project_Nodes.Table (Node).Kind = N_With_Clause
828 or else
829 Project_Nodes.Table (Node).Kind = N_Variable_Reference
830 or else
831 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
832 return Project_Nodes.Table (Node).Field1;
833 end Project_Node_Of;
834
835 -----------------------------------
836 -- Project_Of_Renamed_Package_Of --
837 -----------------------------------
838
839 function Project_Of_Renamed_Package_Of
840 (Node : Project_Node_Id)
841 return Project_Node_Id
842 is
843 begin
844 pragma Assert
845 (Node /= Empty_Node
846 and then
847 Project_Nodes.Table (Node).Kind = N_Package_Declaration);
848 return Project_Nodes.Table (Node).Field1;
849 end Project_Of_Renamed_Package_Of;
850
851 ------------------------------------
852 -- Set_Associative_Array_Index_Of --
853 ------------------------------------
854
855 procedure Set_Associative_Array_Index_Of
856 (Node : Project_Node_Id;
857 To : Name_Id)
858 is
859 begin
860 pragma Assert
861 (Node /= Empty_Node
862 and then
863 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
864 or else
865 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
866 Project_Nodes.Table (Node).Value := To;
867 end Set_Associative_Array_Index_Of;
868
869 --------------------------------
870 -- Set_Associative_Package_Of --
871 --------------------------------
872
873 procedure Set_Associative_Package_Of
874 (Node : Project_Node_Id;
875 To : Project_Node_Id)
876 is
877 begin
878 pragma Assert
879 (Node /= Empty_Node
880 and then
881 Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
882 Project_Nodes.Table (Node).Field3 := To;
883 end Set_Associative_Package_Of;
884
885 --------------------------------
886 -- Set_Associative_Project_Of --
887 --------------------------------
888
889 procedure Set_Associative_Project_Of
890 (Node : Project_Node_Id;
891 To : Project_Node_Id)
892 is
893 begin
894 pragma Assert
895 (Node /= Empty_Node
896 and then
897 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
898 Project_Nodes.Table (Node).Field2 := To;
899 end Set_Associative_Project_Of;
900
901 --------------------------
902 -- Set_Case_Insensitive --
903 --------------------------
904
905 procedure Set_Case_Insensitive
906 (Node : Project_Node_Id;
907 To : Boolean)
908 is
909 begin
910 pragma Assert
911 (Node /= Empty_Node
912 and then
913 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
914 or else
915 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
916 Project_Nodes.Table (Node).Case_Insensitive := To;
917 end Set_Case_Insensitive;
918
919 ------------------------------------
920 -- Set_Case_Variable_Reference_Of --
921 ------------------------------------
922
923 procedure Set_Case_Variable_Reference_Of
924 (Node : Project_Node_Id;
925 To : Project_Node_Id)
926 is
927 begin
928 pragma Assert
929 (Node /= Empty_Node
930 and then
931 Project_Nodes.Table (Node).Kind = N_Case_Construction);
932 Project_Nodes.Table (Node).Field1 := To;
933 end Set_Case_Variable_Reference_Of;
934
935 ---------------------------
936 -- Set_Current_Item_Node --
937 ---------------------------
938
939 procedure Set_Current_Item_Node
940 (Node : Project_Node_Id;
941 To : Project_Node_Id)
942 is
943 begin
944 pragma Assert
945 (Node /= Empty_Node
946 and then
947 Project_Nodes.Table (Node).Kind = N_Declarative_Item);
948 Project_Nodes.Table (Node).Field1 := To;
949 end Set_Current_Item_Node;
950
951 ----------------------
952 -- Set_Current_Term --
953 ----------------------
954
955 procedure Set_Current_Term
956 (Node : Project_Node_Id;
957 To : Project_Node_Id)
958 is
959 begin
960 pragma Assert
961 (Node /= Empty_Node
962 and then
963 Project_Nodes.Table (Node).Kind = N_Term);
964 Project_Nodes.Table (Node).Field1 := To;
965 end Set_Current_Term;
966
967 ----------------------
968 -- Set_Directory_Of --
969 ----------------------
970
971 procedure Set_Directory_Of
972 (Node : Project_Node_Id;
973 To : Name_Id)
974 is
975 begin
976 pragma Assert
977 (Node /= Empty_Node
978 and then
979 Project_Nodes.Table (Node).Kind = N_Project);
980 Project_Nodes.Table (Node).Directory := To;
981 end Set_Directory_Of;
982
983 ----------------------------
984 -- Set_Expression_Kind_Of --
985 ----------------------------
986
987 procedure Set_Expression_Kind_Of
988 (Node : Project_Node_Id;
989 To : Variable_Kind)
990 is
991 begin
992 pragma Assert
993 (Node /= Empty_Node
994 and then
995 (Project_Nodes.Table (Node).Kind = N_Literal_String
996 or else
997 Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
998 or else
999 Project_Nodes.Table (Node).Kind = N_Variable_Declaration
1000 or else
1001 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
1002 or else
1003 Project_Nodes.Table (Node).Kind = N_Package_Declaration
1004 or else
1005 Project_Nodes.Table (Node).Kind = N_Expression
1006 or else
1007 Project_Nodes.Table (Node).Kind = N_Term
1008 or else
1009 Project_Nodes.Table (Node).Kind = N_Variable_Reference
1010 or else
1011 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1012 Project_Nodes.Table (Node).Expr_Kind := To;
1013 end Set_Expression_Kind_Of;
1014
1015 -----------------------
1016 -- Set_Expression_Of --
1017 -----------------------
1018
1019 procedure Set_Expression_Of
1020 (Node : Project_Node_Id;
1021 To : Project_Node_Id)
1022 is
1023 begin
1024 pragma Assert
1025 (Node /= Empty_Node
1026 and then
1027 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1028 or else
1029 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
1030 or else
1031 Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
1032 Project_Nodes.Table (Node).Field1 := To;
1033 end Set_Expression_Of;
1034
1035 -------------------------------
1036 -- Set_External_Reference_Of --
1037 -------------------------------
1038
1039 procedure Set_External_Reference_Of
1040 (Node : Project_Node_Id;
1041 To : Project_Node_Id)
1042 is
1043 begin
1044 pragma Assert
1045 (Node /= Empty_Node
1046 and then
1047 Project_Nodes.Table (Node).Kind = N_External_Value);
1048 Project_Nodes.Table (Node).Field1 := To;
1049 end Set_External_Reference_Of;
1050
1051 -----------------------------
1052 -- Set_External_Default_Of --
1053 -----------------------------
1054
1055 procedure Set_External_Default_Of
1056 (Node : Project_Node_Id;
1057 To : Project_Node_Id)
1058 is
1059 begin
1060 pragma Assert
1061 (Node /= Empty_Node
1062 and then
1063 Project_Nodes.Table (Node).Kind = N_External_Value);
1064 Project_Nodes.Table (Node).Field2 := To;
1065 end Set_External_Default_Of;
1066
1067 ----------------------------
1068 -- Set_First_Case_Item_Of --
1069 ----------------------------
1070
1071 procedure Set_First_Case_Item_Of
1072 (Node : Project_Node_Id;
1073 To : Project_Node_Id)
1074 is
1075 begin
1076 pragma Assert
1077 (Node /= Empty_Node
1078 and then
1079 Project_Nodes.Table (Node).Kind = N_Case_Construction);
1080 Project_Nodes.Table (Node).Field2 := To;
1081 end Set_First_Case_Item_Of;
1082
1083 -------------------------
1084 -- Set_First_Choice_Of --
1085 -------------------------
1086
1087 procedure Set_First_Choice_Of
1088 (Node : Project_Node_Id;
1089 To : Project_Node_Id)
1090 is
1091 begin
1092 pragma Assert
1093 (Node /= Empty_Node
1094 and then
1095 Project_Nodes.Table (Node).Kind = N_Case_Item);
1096 Project_Nodes.Table (Node).Field1 := To;
1097 end Set_First_Choice_Of;
1098
1099 ------------------------
1100 -- Set_Next_Case_Item --
1101 ------------------------
1102
1103 procedure Set_Next_Case_Item
1104 (Node : Project_Node_Id;
1105 To : Project_Node_Id)
1106 is
1107 begin
1108 pragma Assert
1109 (Node /= Empty_Node
1110 and then
1111 Project_Nodes.Table (Node).Kind = N_Case_Item);
1112 Project_Nodes.Table (Node).Field3 := To;
1113 end Set_Next_Case_Item;
1114
1115 -----------------------------------
1116 -- Set_First_Declarative_Item_Of --
1117 -----------------------------------
1118
1119 procedure Set_First_Declarative_Item_Of
1120 (Node : Project_Node_Id;
1121 To : Project_Node_Id)
1122 is
1123 begin
1124 pragma Assert
1125 (Node /= Empty_Node
1126 and then
1127 (Project_Nodes.Table (Node).Kind = N_Project_Declaration
1128 or else
1129 Project_Nodes.Table (Node).Kind = N_Case_Item
1130 or else
1131 Project_Nodes.Table (Node).Kind = N_Package_Declaration));
1132
1133 if Project_Nodes.Table (Node).Kind = N_Project_Declaration then
1134 Project_Nodes.Table (Node).Field1 := To;
1135 else
1136 Project_Nodes.Table (Node).Field2 := To;
1137 end if;
1138 end Set_First_Declarative_Item_Of;
1139
1140 ----------------------------------
1141 -- Set_First_Expression_In_List --
1142 ----------------------------------
1143
1144 procedure Set_First_Expression_In_List
1145 (Node : Project_Node_Id;
1146 To : Project_Node_Id)
1147 is
1148 begin
1149 pragma Assert
1150 (Node /= Empty_Node
1151 and then
1152 Project_Nodes.Table (Node).Kind = N_Literal_String_List);
1153 Project_Nodes.Table (Node).Field1 := To;
1154 end Set_First_Expression_In_List;
1155
1156 ------------------------------
1157 -- Set_First_Literal_String --
1158 ------------------------------
1159
1160 procedure Set_First_Literal_String
1161 (Node : Project_Node_Id;
1162 To : Project_Node_Id)
1163 is
1164 begin
1165 pragma Assert
1166 (Node /= Empty_Node
1167 and then
1168 Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
1169 Project_Nodes.Table (Node).Field1 := To;
1170 end Set_First_Literal_String;
1171
1172 --------------------------
1173 -- Set_First_Package_Of --
1174 --------------------------
1175
1176 procedure Set_First_Package_Of
1177 (Node : Project_Node_Id;
1178 To : Package_Declaration_Id)
1179 is
1180 begin
1181 pragma Assert
1182 (Node /= Empty_Node
1183 and then
1184 Project_Nodes.Table (Node).Kind = N_Project);
1185 Project_Nodes.Table (Node).Packages := To;
1186 end Set_First_Package_Of;
1187
1188 ------------------------------
1189 -- Set_First_String_Type_Of --
1190 ------------------------------
1191
1192 procedure Set_First_String_Type_Of
1193 (Node : Project_Node_Id;
1194 To : Project_Node_Id)
1195 is
1196 begin
1197 pragma Assert
1198 (Node /= Empty_Node
1199 and then
1200 Project_Nodes.Table (Node).Kind = N_Project);
1201 Project_Nodes.Table (Node).Field3 := To;
1202 end Set_First_String_Type_Of;
1203
1204 --------------------
1205 -- Set_First_Term --
1206 --------------------
1207
1208 procedure Set_First_Term
1209 (Node : Project_Node_Id;
1210 To : Project_Node_Id)
1211 is
1212 begin
1213 pragma Assert
1214 (Node /= Empty_Node
1215 and then
1216 Project_Nodes.Table (Node).Kind = N_Expression);
1217 Project_Nodes.Table (Node).Field1 := To;
1218 end Set_First_Term;
1219
1220 ---------------------------
1221 -- Set_First_Variable_Of --
1222 ---------------------------
1223
1224 procedure Set_First_Variable_Of
1225 (Node : Project_Node_Id;
1226 To : Variable_Node_Id)
1227 is
1228 begin
1229 pragma Assert
1230 (Node /= Empty_Node
1231 and then
1232 (Project_Nodes.Table (Node).Kind = N_Project
1233 or else
1234 Project_Nodes.Table (Node).Kind = N_Package_Declaration));
1235 Project_Nodes.Table (Node).Variables := To;
1236 end Set_First_Variable_Of;
1237
1238 ------------------------------
1239 -- Set_First_With_Clause_Of --
1240 ------------------------------
1241
1242 procedure Set_First_With_Clause_Of
1243 (Node : Project_Node_Id;
1244 To : Project_Node_Id)
1245 is
1246 begin
1247 pragma Assert
1248 (Node /= Empty_Node
1249 and then
1250 Project_Nodes.Table (Node).Kind = N_Project);
1251 Project_Nodes.Table (Node).Field1 := To;
1252 end Set_First_With_Clause_Of;
1253
1254 --------------------------
1255 -- Set_Is_Extending_All --
1256 --------------------------
1257
1258 procedure Set_Is_Extending_All (Node : Project_Node_Id) is
1259 begin
1260 pragma Assert
1261 (Node /= Empty_Node
1262 and then
1263 Project_Nodes.Table (Node).Kind = N_Project);
1264 Project_Nodes.Table (Node).Extending_All := True;
1265 end Set_Is_Extending_All;
1266
1267 -----------------
1268 -- Set_Kind_Of --
1269 -----------------
1270
1271 procedure Set_Kind_Of
1272 (Node : Project_Node_Id;
1273 To : Project_Node_Kind)
1274 is
1275 begin
1276 pragma Assert (Node /= Empty_Node);
1277 Project_Nodes.Table (Node).Kind := To;
1278 end Set_Kind_Of;
1279
1280 ---------------------
1281 -- Set_Location_Of --
1282 ---------------------
1283
1284 procedure Set_Location_Of
1285 (Node : Project_Node_Id;
1286 To : Source_Ptr)
1287 is
1288 begin
1289 pragma Assert (Node /= Empty_Node);
1290 Project_Nodes.Table (Node).Location := To;
1291 end Set_Location_Of;
1292
1293 -----------------------------
1294 -- Set_Extended_Project_Of --
1295 -----------------------------
1296
1297 procedure Set_Extended_Project_Of
1298 (Node : Project_Node_Id;
1299 To : Project_Node_Id)
1300 is
1301 begin
1302 pragma Assert
1303 (Node /= Empty_Node
1304 and then
1305 Project_Nodes.Table (Node).Kind = N_Project_Declaration);
1306 Project_Nodes.Table (Node).Field2 := To;
1307 end Set_Extended_Project_Of;
1308
1309 ----------------------------------
1310 -- Set_Extended_Project_Path_Of --
1311 ----------------------------------
1312
1313 procedure Set_Extended_Project_Path_Of
1314 (Node : Project_Node_Id;
1315 To : Name_Id)
1316 is
1317 begin
1318 pragma Assert
1319 (Node /= Empty_Node
1320 and then
1321 Project_Nodes.Table (Node).Kind = N_Project);
1322 Project_Nodes.Table (Node).Value := To;
1323 end Set_Extended_Project_Path_Of;
1324
1325 ------------------------------
1326 -- Set_Extending_Project_Of --
1327 ------------------------------
1328
1329 procedure Set_Extending_Project_Of
1330 (Node : Project_Node_Id;
1331 To : Project_Node_Id)
1332 is
1333 begin
1334 pragma Assert
1335 (Node /= Empty_Node
1336 and then
1337 Project_Nodes.Table (Node).Kind = N_Project_Declaration);
1338 Project_Nodes.Table (Node).Field3 := To;
1339 end Set_Extending_Project_Of;
1340
1341 -----------------
1342 -- Set_Name_Of --
1343 -----------------
1344
1345 procedure Set_Name_Of
1346 (Node : Project_Node_Id;
1347 To : Name_Id)
1348 is
1349 begin
1350 pragma Assert (Node /= Empty_Node);
1351 Project_Nodes.Table (Node).Name := To;
1352 end Set_Name_Of;
1353
1354 -------------------------------
1355 -- Set_Next_Declarative_Item --
1356 -------------------------------
1357
1358 procedure Set_Next_Declarative_Item
1359 (Node : Project_Node_Id;
1360 To : Project_Node_Id)
1361 is
1362 begin
1363 pragma Assert
1364 (Node /= Empty_Node
1365 and then
1366 Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1367 Project_Nodes.Table (Node).Field2 := To;
1368 end Set_Next_Declarative_Item;
1369
1370 ---------------------------------
1371 -- Set_Next_Expression_In_List --
1372 ---------------------------------
1373
1374 procedure Set_Next_Expression_In_List
1375 (Node : Project_Node_Id;
1376 To : Project_Node_Id)
1377 is
1378 begin
1379 pragma Assert
1380 (Node /= Empty_Node
1381 and then
1382 Project_Nodes.Table (Node).Kind = N_Expression);
1383 Project_Nodes.Table (Node).Field2 := To;
1384 end Set_Next_Expression_In_List;
1385
1386 -----------------------------
1387 -- Set_Next_Literal_String --
1388 -----------------------------
1389
1390 procedure Set_Next_Literal_String
1391 (Node : Project_Node_Id;
1392 To : Project_Node_Id)
1393 is
1394 begin
1395 pragma Assert
1396 (Node /= Empty_Node
1397 and then
1398 Project_Nodes.Table (Node).Kind = N_Literal_String);
1399 Project_Nodes.Table (Node).Field1 := To;
1400 end Set_Next_Literal_String;
1401
1402 ---------------------------------
1403 -- Set_Next_Package_In_Project --
1404 ---------------------------------
1405
1406 procedure Set_Next_Package_In_Project
1407 (Node : Project_Node_Id;
1408 To : Project_Node_Id)
1409 is
1410 begin
1411 pragma Assert
1412 (Node /= Empty_Node
1413 and then
1414 Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1415 Project_Nodes.Table (Node).Field3 := To;
1416 end Set_Next_Package_In_Project;
1417
1418 --------------------------
1419 -- Set_Next_String_Type --
1420 --------------------------
1421
1422 procedure Set_Next_String_Type
1423 (Node : Project_Node_Id;
1424 To : Project_Node_Id)
1425 is
1426 begin
1427 pragma Assert
1428 (Node /= Empty_Node
1429 and then
1430 Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
1431 Project_Nodes.Table (Node).Field2 := To;
1432 end Set_Next_String_Type;
1433
1434 -------------------
1435 -- Set_Next_Term --
1436 -------------------
1437
1438 procedure Set_Next_Term
1439 (Node : Project_Node_Id;
1440 To : Project_Node_Id)
1441 is
1442 begin
1443 pragma Assert
1444 (Node /= Empty_Node
1445 and then
1446 Project_Nodes.Table (Node).Kind = N_Term);
1447 Project_Nodes.Table (Node).Field2 := To;
1448 end Set_Next_Term;
1449
1450 -----------------------
1451 -- Set_Next_Variable --
1452 -----------------------
1453
1454 procedure Set_Next_Variable
1455 (Node : Project_Node_Id;
1456 To : Project_Node_Id)
1457 is
1458 begin
1459 pragma Assert
1460 (Node /= Empty_Node
1461 and then
1462 (Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
1463 or else
1464 Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
1465 Project_Nodes.Table (Node).Field3 := To;
1466 end Set_Next_Variable;
1467
1468 -----------------------------
1469 -- Set_Next_With_Clause_Of --
1470 -----------------------------
1471
1472 procedure Set_Next_With_Clause_Of
1473 (Node : Project_Node_Id;
1474 To : Project_Node_Id)
1475 is
1476 begin
1477 pragma Assert
1478 (Node /= Empty_Node
1479 and then
1480 Project_Nodes.Table (Node).Kind = N_With_Clause);
1481 Project_Nodes.Table (Node).Field2 := To;
1482 end Set_Next_With_Clause_Of;
1483
1484 -----------------------
1485 -- Set_Package_Id_Of --
1486 -----------------------
1487
1488 procedure Set_Package_Id_Of
1489 (Node : Project_Node_Id;
1490 To : Package_Node_Id)
1491 is
1492 begin
1493 pragma Assert
1494 (Node /= Empty_Node
1495 and then
1496 Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1497 Project_Nodes.Table (Node).Pkg_Id := To;
1498 end Set_Package_Id_Of;
1499
1500 -------------------------
1501 -- Set_Package_Node_Of --
1502 -------------------------
1503
1504 procedure Set_Package_Node_Of
1505 (Node : Project_Node_Id;
1506 To : Project_Node_Id)
1507 is
1508 begin
1509 pragma Assert
1510 (Node /= Empty_Node
1511 and then
1512 (Project_Nodes.Table (Node).Kind = N_Variable_Reference
1513 or else
1514 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1515 Project_Nodes.Table (Node).Field2 := To;
1516 end Set_Package_Node_Of;
1517
1518 ----------------------
1519 -- Set_Path_Name_Of --
1520 ----------------------
1521
1522 procedure Set_Path_Name_Of
1523 (Node : Project_Node_Id;
1524 To : Name_Id)
1525 is
1526 begin
1527 pragma Assert
1528 (Node /= Empty_Node
1529 and then
1530 (Project_Nodes.Table (Node).Kind = N_Project
1531 or else
1532 Project_Nodes.Table (Node).Kind = N_With_Clause));
1533 Project_Nodes.Table (Node).Path_Name := To;
1534 end Set_Path_Name_Of;
1535
1536 --------------------------------
1537 -- Set_Project_Declaration_Of --
1538 --------------------------------
1539
1540 procedure Set_Project_Declaration_Of
1541 (Node : Project_Node_Id;
1542 To : Project_Node_Id)
1543 is
1544 begin
1545 pragma Assert
1546 (Node /= Empty_Node
1547 and then
1548 Project_Nodes.Table (Node).Kind = N_Project);
1549 Project_Nodes.Table (Node).Field2 := To;
1550 end Set_Project_Declaration_Of;
1551
1552 -------------------------
1553 -- Set_Project_Node_Of --
1554 -------------------------
1555
1556 procedure Set_Project_Node_Of
1557 (Node : Project_Node_Id;
1558 To : Project_Node_Id;
1559 Limited_With : Boolean := False)
1560 is
1561 begin
1562 pragma Assert
1563 (Node /= Empty_Node
1564 and then
1565 (Project_Nodes.Table (Node).Kind = N_With_Clause
1566 or else
1567 Project_Nodes.Table (Node).Kind = N_Variable_Reference
1568 or else
1569 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1570 Project_Nodes.Table (Node).Field1 := To;
1571
1572 if Project_Nodes.Table (Node).Kind = N_With_Clause
1573 and then not Limited_With
1574 then
1575 Project_Nodes.Table (Node).Field3 := To;
1576 end if;
1577 end Set_Project_Node_Of;
1578
1579 ---------------------------------------
1580 -- Set_Project_Of_Renamed_Package_Of --
1581 ---------------------------------------
1582
1583 procedure Set_Project_Of_Renamed_Package_Of
1584 (Node : Project_Node_Id;
1585 To : Project_Node_Id)
1586 is
1587 begin
1588 pragma Assert
1589 (Node /= Empty_Node
1590 and then
1591 Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1592 Project_Nodes.Table (Node).Field1 := To;
1593 end Set_Project_Of_Renamed_Package_Of;
1594
1595 ------------------------
1596 -- Set_String_Type_Of --
1597 ------------------------
1598
1599 procedure Set_String_Type_Of
1600 (Node : Project_Node_Id;
1601 To : Project_Node_Id)
1602 is
1603 begin
1604 pragma Assert
1605 (Node /= Empty_Node
1606 and then
1607 (Project_Nodes.Table (Node).Kind = N_Variable_Reference
1608 or else
1609 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration)
1610 and then
1611 Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
1612
1613 if Project_Nodes.Table (Node).Kind = N_Variable_Reference then
1614 Project_Nodes.Table (Node).Field3 := To;
1615 else
1616 Project_Nodes.Table (Node).Field2 := To;
1617 end if;
1618 end Set_String_Type_Of;
1619
1620 -------------------------
1621 -- Set_String_Value_Of --
1622 -------------------------
1623
1624 procedure Set_String_Value_Of
1625 (Node : Project_Node_Id;
1626 To : Name_Id)
1627 is
1628 begin
1629 pragma Assert
1630 (Node /= Empty_Node
1631 and then
1632 (Project_Nodes.Table (Node).Kind = N_With_Clause
1633 or else
1634 Project_Nodes.Table (Node).Kind = N_Literal_String));
1635 Project_Nodes.Table (Node).Value := To;
1636 end Set_String_Value_Of;
1637
1638 --------------------
1639 -- String_Type_Of --
1640 --------------------
1641
1642 function String_Type_Of (Node : Project_Node_Id)
1643 return Project_Node_Id is
1644 begin
1645 pragma Assert
1646 (Node /= Empty_Node
1647 and then
1648 (Project_Nodes.Table (Node).Kind = N_Variable_Reference
1649 or else
1650 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration));
1651
1652 if Project_Nodes.Table (Node).Kind = N_Variable_Reference then
1653 return Project_Nodes.Table (Node).Field3;
1654 else
1655 return Project_Nodes.Table (Node).Field2;
1656 end if;
1657 end String_Type_Of;
1658
1659 ---------------------
1660 -- String_Value_Of --
1661 ---------------------
1662
1663 function String_Value_Of (Node : Project_Node_Id) return Name_Id is
1664 begin
1665 pragma Assert
1666 (Node /= Empty_Node
1667 and then
1668 (Project_Nodes.Table (Node).Kind = N_With_Clause
1669 or else
1670 Project_Nodes.Table (Node).Kind = N_Literal_String));
1671 return Project_Nodes.Table (Node).Value;
1672 end String_Value_Of;
1673
1674 --------------------
1675 -- Value_Is_Valid --
1676 --------------------
1677
1678 function Value_Is_Valid
1679 (For_Typed_Variable : Project_Node_Id;
1680 Value : Name_Id)
1681 return Boolean
1682 is
1683 begin
1684 pragma Assert
1685 (For_Typed_Variable /= Empty_Node
1686 and then
1687 (Project_Nodes.Table (For_Typed_Variable).Kind =
1688 N_Typed_Variable_Declaration));
1689
1690 declare
1691 Current_String : Project_Node_Id :=
1692 First_Literal_String
1693 (String_Type_Of (For_Typed_Variable));
1694
1695 begin
1696 while Current_String /= Empty_Node
1697 and then
1698 String_Value_Of (Current_String) /= Value
1699 loop
1700 Current_String :=
1701 Next_Literal_String (Current_String);
1702 end loop;
1703
1704 return Current_String /= Empty_Node;
1705 end;
1706
1707 end Value_Is_Valid;
1708
1709 end Prj.Tree;