?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
* sh.h (REG_CLASS_FROM_LETTER): Change to:
[official-gcc.git] / gcc / ada / prj-proc.adb
blob8ad23289b3111edaec2a51dafc9de897df7729f9
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . P R O C --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2002 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 with Errout; use Errout;
28 with Namet; use Namet;
29 with Opt;
30 with Output; use Output;
31 with Prj.Attr; use Prj.Attr;
32 with Prj.Com; use Prj.Com;
33 with Prj.Ext; use Prj.Ext;
34 with Prj.Nmsc; use Prj.Nmsc;
35 with Stringt; use Stringt;
36
37 with GNAT.Case_Util; use GNAT.Case_Util;
38 with GNAT.HTable;
39
40 package body Prj.Proc is
41
42 Error_Report : Put_Line_Access := null;
43
44 package Processed_Projects is new GNAT.HTable.Simple_HTable
45 (Header_Num => Header_Num,
46 Element => Project_Id,
47 No_Element => No_Project,
48 Key => Name_Id,
49 Hash => Hash,
50 Equal => "=");
51 -- This hash table contains all processed projects
52
53 procedure Add (To_Exp : in out String_Id; Str : String_Id);
54 -- Concatenate two strings and returns another string if both
55 -- arguments are not null string.
56
57 procedure Add_Attributes
58 (Decl : in out Declarations;
59 First : Attribute_Node_Id);
60 -- Add all attributes, starting with First, with their default
61 -- values to the package or project with declarations Decl.
62
63 function Expression
64 (Project : Project_Id;
65 From_Project_Node : Project_Node_Id;
66 Pkg : Package_Id;
67 First_Term : Project_Node_Id;
68 Kind : Variable_Kind)
69 return Variable_Value;
70 -- From N_Expression project node From_Project_Node, compute the value
71 -- of an expression and return it as a Variable_Value.
72
73 function Imported_Or_Modified_Project_From
74 (Project : Project_Id;
75 With_Name : Name_Id)
76 return Project_Id;
77 -- Find an imported or modified project of Project whose name is With_Name
78
79 function Package_From
80 (Project : Project_Id;
81 With_Name : Name_Id)
82 return Package_Id;
83 -- Find the package of Project whose name is With_Name
84
85 procedure Process_Declarative_Items
86 (Project : Project_Id;
87 From_Project_Node : Project_Node_Id;
88 Pkg : Package_Id;
89 Item : Project_Node_Id);
90 -- Process declarative items starting with From_Project_Node, and put them
91 -- in declarations Decl. This is a recursive procedure; it calls itself for
92 -- a package declaration or a case construction.
93
94 procedure Recursive_Process
95 (Project : out Project_Id;
96 From_Project_Node : Project_Node_Id;
97 Modified_By : Project_Id);
98 -- Process project with node From_Project_Node in the tree.
99 -- Do nothing if From_Project_Node is Empty_Node.
100 -- If project has already been processed, simply return its project id.
101 -- Otherwise create a new project id, mark it as processed, call itself
102 -- recursively for all imported projects and a modified project, if any.
103 -- Then process the declarative items of the project.
104
105 procedure Check (Project : in out Project_Id);
106 -- Set all projects to not checked, then call Recursive_Check for the
107 -- main project Project. Project is set to No_Project if errors occurred.
108
109 procedure Recursive_Check (Project : Project_Id);
110 -- If Project is marked as not checked, mark it as checked, call
111 -- Check_Naming_Scheme for the project, then call itself for a
112 -- possible modified project and all the imported projects of Project.
113
114 ---------
115 -- Add --
116 ---------
117
118 procedure Add (To_Exp : in out String_Id; Str : String_Id) is
119 begin
120 if To_Exp = Types.No_String or else String_Length (To_Exp) = 0 then
121
122 -- To_Exp is nil or empty. The result is Str.
123
124 To_Exp := Str;
125
126 -- If Str is nil, then do not change To_Ext
127
128 elsif Str /= No_String then
129 Start_String (To_Exp);
130 Store_String_Chars (Str);
131 To_Exp := End_String;
132 end if;
133 end Add;
134
135 --------------------
136 -- Add_Attributes --
137 --------------------
138
139 procedure Add_Attributes
140 (Decl : in out Declarations;
141 First : Attribute_Node_Id) is
142 The_Attribute : Attribute_Node_Id := First;
143 Attribute_Data : Attribute_Record;
144
145 begin
146 while The_Attribute /= Empty_Attribute loop
147 Attribute_Data := Attributes.Table (The_Attribute);
148
149 if Attribute_Data.Kind_2 /= Associative_Array then
150 declare
151 New_Attribute : Variable_Value;
152
153 begin
154 case Attribute_Data.Kind_1 is
155
156 -- Undefined should not happen
157
158 when Undefined =>
159 pragma Assert
160 (False, "attribute with an undefined kind");
161 raise Program_Error;
162
163 -- Single attributes have a default value of empty string
164
165 when Single =>
166 New_Attribute :=
167 (Kind => Single,
168 Location => No_Location,
169 Default => True,
170 Value => Empty_String);
171
172 -- List attributes have a default value of nil list
173
174 when List =>
175 New_Attribute :=
176 (Kind => List,
177 Location => No_Location,
178 Default => True,
179 Values => Nil_String);
180
181 end case;
182
183 Variable_Elements.Increment_Last;
184 Variable_Elements.Table (Variable_Elements.Last) :=
185 (Next => Decl.Attributes,
186 Name => Attribute_Data.Name,
187 Value => New_Attribute);
188 Decl.Attributes := Variable_Elements.Last;
189 end;
190 end if;
191
192 The_Attribute := Attributes.Table (The_Attribute).Next;
193 end loop;
194
195 end Add_Attributes;
196
197 -----------
198 -- Check --
199 -----------
200
201 procedure Check (Project : in out Project_Id) is
202 begin
203 -- Make sure that all projects are marked as not checked
204
205 for Index in 1 .. Projects.Last loop
206 Projects.Table (Index).Checked := False;
207 end loop;
208
209 Recursive_Check (Project);
210
211 if Errout.Total_Errors_Detected > 0 then
212 Project := No_Project;
213 end if;
214
215 end Check;
216
217 ----------------
218 -- Expression --
219 ----------------
220
221 function Expression
222 (Project : Project_Id;
223 From_Project_Node : Project_Node_Id;
224 Pkg : Package_Id;
225 First_Term : Project_Node_Id;
226 Kind : Variable_Kind)
227 return Variable_Value
228 is
229 The_Term : Project_Node_Id := First_Term;
230 -- The term in the expression list
231
232 The_Current_Term : Project_Node_Id := Empty_Node;
233 -- The current term node id
234
235 Term_Kind : Variable_Kind;
236 -- The kind of the current term
237
238 Result : Variable_Value (Kind => Kind);
239 -- The returned result
240
241 Last : String_List_Id := Nil_String;
242 -- Reference to the last string elements in Result, when Kind is List.
243
244 begin
245 Result.Location := Location_Of (First_Term);
246
247 -- Process each term of the expression, starting with First_Term
248
249 while The_Term /= Empty_Node loop
250
251 -- We get the term data and kind ...
252
253 Term_Kind := Expression_Kind_Of (The_Term);
254
255 The_Current_Term := Current_Term (The_Term);
256
257 case Kind_Of (The_Current_Term) is
258
259 when N_Literal_String =>
260
261 case Kind is
262
263 when Undefined =>
264
265 -- Should never happen
266
267 pragma Assert (False, "Undefined expression kind");
268 raise Program_Error;
269
270 when Single =>
271 Add (Result.Value, String_Value_Of (The_Current_Term));
272
273 when List =>
274
275 String_Elements.Increment_Last;
276
277 if Last = Nil_String then
278
279 -- This can happen in an expression such as
280 -- () & "toto"
281
282 Result.Values := String_Elements.Last;
283
284 else
285 String_Elements.Table (Last).Next :=
286 String_Elements.Last;
287 end if;
288
289 Last := String_Elements.Last;
290 String_Elements.Table (Last) :=
291 (Value => String_Value_Of (The_Current_Term),
292 Location => Location_Of (The_Current_Term),
293 Next => Nil_String);
294
295 end case;
296
297 when N_Literal_String_List =>
298
299 declare
300 String_Node : Project_Node_Id :=
301 First_Expression_In_List (The_Current_Term);
302
303 Value : Variable_Value;
304
305 begin
306 if String_Node /= Empty_Node then
307
308 -- If String_Node is nil, it is an empty list,
309 -- there is nothing to do
310
311 Value := Expression
312 (Project => Project,
313 From_Project_Node => From_Project_Node,
314 Pkg => Pkg,
315 First_Term => Tree.First_Term (String_Node),
316 Kind => Single);
317 String_Elements.Increment_Last;
318
319 if Result.Values = Nil_String then
320
321 -- This literal string list is the first term
322 -- in a string list expression
323
324 Result.Values := String_Elements.Last;
325
326 else
327 String_Elements.Table (Last).Next :=
328 String_Elements.Last;
329 end if;
330
331 Last := String_Elements.Last;
332 String_Elements.Table (Last) :=
333 (Value => Value.Value,
334 Location => Value.Location,
335 Next => Nil_String);
336
337 loop
338 -- Add the other element of the literal string list
339 -- one after the other
340
341 String_Node :=
342 Next_Expression_In_List (String_Node);
343
344 exit when String_Node = Empty_Node;
345
346 Value :=
347 Expression
348 (Project => Project,
349 From_Project_Node => From_Project_Node,
350 Pkg => Pkg,
351 First_Term => Tree.First_Term (String_Node),
352 Kind => Single);
353
354 String_Elements.Increment_Last;
355 String_Elements.Table (Last).Next :=
356 String_Elements.Last;
357 Last := String_Elements.Last;
358 String_Elements.Table (Last) :=
359 (Value => Value.Value,
360 Location => Value.Location,
361 Next => Nil_String);
362 end loop;
363
364 end if;
365
366 end;
367
368 when N_Variable_Reference | N_Attribute_Reference =>
369
370 declare
371 The_Project : Project_Id := Project;
372 The_Package : Package_Id := Pkg;
373 The_Name : Name_Id := No_Name;
374 The_Variable_Id : Variable_Id := No_Variable;
375 The_Variable : Variable_Value;
376 Term_Project : constant Project_Node_Id :=
377 Project_Node_Of (The_Current_Term);
378 Term_Package : constant Project_Node_Id :=
379 Package_Node_Of (The_Current_Term);
380 Index : String_Id := No_String;
381
382 begin
383 if Term_Project /= Empty_Node and then
384 Term_Project /= From_Project_Node
385 then
386 -- This variable or attribute comes from another project
387
388 The_Name := Name_Of (Term_Project);
389 The_Project := Imported_Or_Modified_Project_From
390 (Project => Project, With_Name => The_Name);
391 end if;
392
393 if Term_Package /= Empty_Node then
394
395 -- This is an attribute of a package
396
397 The_Name := Name_Of (Term_Package);
398 The_Package := Projects.Table (The_Project).Decl.Packages;
399
400 while The_Package /= No_Package
401 and then Packages.Table (The_Package).Name /= The_Name
402 loop
403 The_Package := Packages.Table (The_Package).Next;
404 end loop;
405
406 pragma Assert
407 (The_Package /= No_Package,
408 "package not found.");
409
410 elsif Kind_Of (The_Current_Term) = N_Attribute_Reference then
411 The_Package := No_Package;
412 end if;
413
414 The_Name := Name_Of (The_Current_Term);
415
416 if Kind_Of (The_Current_Term) = N_Attribute_Reference then
417 Index := Associative_Array_Index_Of (The_Current_Term);
418 end if;
419
420 -- If it is not an associative array attribute
421
422 if Index = No_String then
423
424 -- It is not an associative array attribute
425
426 if The_Package /= No_Package then
427
428 -- First, if there is a package, look into the package
429
430 if
431 Kind_Of (The_Current_Term) = N_Variable_Reference
432 then
433 The_Variable_Id :=
434 Packages.Table (The_Package).Decl.Variables;
435
436 else
437 The_Variable_Id :=
438 Packages.Table (The_Package).Decl.Attributes;
439 end if;
440
441 while The_Variable_Id /= No_Variable
442 and then
443 Variable_Elements.Table (The_Variable_Id).Name /=
444 The_Name
445 loop
446 The_Variable_Id :=
447 Variable_Elements.Table (The_Variable_Id).Next;
448 end loop;
449
450 end if;
451
452 if The_Variable_Id = No_Variable then
453
454 -- If we have not found it, look into the project
455
456 if
457 Kind_Of (The_Current_Term) = N_Variable_Reference
458 then
459 The_Variable_Id :=
460 Projects.Table (The_Project).Decl.Variables;
461
462 else
463 The_Variable_Id :=
464 Projects.Table (The_Project).Decl.Attributes;
465 end if;
466
467 while The_Variable_Id /= No_Variable
468 and then
469 Variable_Elements.Table (The_Variable_Id).Name /=
470 The_Name
471 loop
472 The_Variable_Id :=
473 Variable_Elements.Table (The_Variable_Id).Next;
474 end loop;
475
476 end if;
477
478 pragma Assert (The_Variable_Id /= No_Variable,
479 "variable or attribute not found");
480
481 The_Variable := Variable_Elements.Table
482 (The_Variable_Id).Value;
483
484 else
485
486 -- It is an associative array attribute
487
488 declare
489 The_Array : Array_Id := No_Array;
490 The_Element : Array_Element_Id := No_Array_Element;
491 Array_Index : Name_Id := No_Name;
492 begin
493 if The_Package /= No_Package then
494 The_Array :=
495 Packages.Table (The_Package).Decl.Arrays;
496
497 else
498 The_Array :=
499 Projects.Table (The_Project).Decl.Arrays;
500 end if;
501
502 while The_Array /= No_Array
503 and then Arrays.Table (The_Array).Name /= The_Name
504 loop
505 The_Array := Arrays.Table (The_Array).Next;
506 end loop;
507
508 if The_Array /= No_Array then
509 The_Element := Arrays.Table (The_Array).Value;
510
511 String_To_Name_Buffer (Index);
512
513 if Case_Insensitive (The_Current_Term) then
514 To_Lower (Name_Buffer (1 .. Name_Len));
515 end if;
516
517 Array_Index := Name_Find;
518
519 while The_Element /= No_Array_Element
520 and then Array_Elements.Table (The_Element).Index
521 /= Array_Index
522 loop
523 The_Element :=
524 Array_Elements.Table (The_Element).Next;
525 end loop;
526
527 end if;
528
529 if The_Element /= No_Array_Element then
530 The_Variable :=
531 Array_Elements.Table (The_Element).Value;
532
533 else
534 if
535 Expression_Kind_Of (The_Current_Term) = List
536 then
537 The_Variable :=
538 (Kind => List,
539 Location => No_Location,
540 Default => True,
541 Values => Nil_String);
542
543 else
544 The_Variable :=
545 (Kind => Single,
546 Location => No_Location,
547 Default => True,
548 Value => Empty_String);
549 end if;
550
551 end if;
552
553 end;
554
555 end if;
556
557 case Kind is
558
559 when Undefined =>
560
561 -- Should never happen
562
563 pragma Assert (False, "undefined expression kind");
564 null;
565
566 when Single =>
567
568 case The_Variable.Kind is
569
570 when Undefined =>
571 null;
572
573 when Single =>
574 Add (Result.Value, The_Variable.Value);
575
576 when List =>
577
578 -- Should never happen
579
580 pragma Assert
581 (False,
582 "list cannot appear in single " &
583 "string expression");
584 null;
585
586 end case;
587
588 when List =>
589 case The_Variable.Kind is
590
591 when Undefined =>
592 null;
593
594 when Single =>
595 String_Elements.Increment_Last;
596
597 if Last = Nil_String then
598
599 -- This can happen in an expression such as
600 -- () & Var
601
602 Result.Values := String_Elements.Last;
603
604 else
605 String_Elements.Table (Last).Next :=
606 String_Elements.Last;
607 end if;
608
609 Last := String_Elements.Last;
610 String_Elements.Table (Last) :=
611 (Value => The_Variable.Value,
612 Location => Location_Of (The_Current_Term),
613 Next => Nil_String);
614
615 when List =>
616
617 declare
618 The_List : String_List_Id :=
619 The_Variable.Values;
620
621 begin
622 while The_List /= Nil_String loop
623 String_Elements.Increment_Last;
624
625 if Last = Nil_String then
626 Result.Values := String_Elements.Last;
627
628 else
629 String_Elements.Table (Last).Next :=
630 String_Elements.Last;
631
632 end if;
633
634 Last := String_Elements.Last;
635 String_Elements.Table (Last) :=
636 (Value =>
637 String_Elements.Table
638 (The_List).Value,
639 Location => Location_Of
640 (The_Current_Term),
641 Next => Nil_String);
642 The_List :=
643 String_Elements.Table (The_List).Next;
644
645 end loop;
646 end;
647 end case;
648 end case;
649 end;
650
651 when N_External_Value =>
652 String_To_Name_Buffer
653 (String_Value_Of (External_Reference_Of (The_Current_Term)));
654
655 declare
656 Name : constant Name_Id := Name_Find;
657 Default : String_Id := No_String;
658 Value : String_Id := No_String;
659
660 Default_Node : constant Project_Node_Id :=
661 External_Default_Of (The_Current_Term);
662
663 begin
664 if Default_Node /= Empty_Node then
665 Default := String_Value_Of (Default_Node);
666 end if;
667
668 Value := Prj.Ext.Value_Of (Name, Default);
669
670 if Value = No_String then
671 if Error_Report = null then
672 Error_Msg
673 ("undefined external reference",
674 Location_Of (The_Current_Term));
675
676 else
677 Error_Report
678 ("""" & Get_Name_String (Name) &
679 """ is an undefined external reference",
680 Project);
681 end if;
682
683 Value := Empty_String;
684
685 end if;
686
687 case Kind is
688
689 when Undefined =>
690 null;
691
692 when Single =>
693 Add (Result.Value, Value);
694
695 when List =>
696 String_Elements.Increment_Last;
697
698 if Last = Nil_String then
699 Result.Values := String_Elements.Last;
700
701 else
702 String_Elements.Table (Last).Next :=
703 String_Elements.Last;
704 end if;
705
706 Last := String_Elements.Last;
707 String_Elements.Table (Last) :=
708 (Value => Value,
709 Location => Location_Of (The_Current_Term),
710 Next => Nil_String);
711
712 end case;
713
714 end;
715
716 when others =>
717
718 -- Should never happen
719
720 pragma Assert
721 (False,
722 "illegal node kind in an expression");
723 raise Program_Error;
724
725 end case;
726
727 The_Term := Next_Term (The_Term);
728 end loop;
729
730 return Result;
731 end Expression;
732
733 ---------------------------------------
734 -- Imported_Or_Modified_Project_From --
735 ---------------------------------------
736
737 function Imported_Or_Modified_Project_From
738 (Project : Project_Id;
739 With_Name : Name_Id)
740 return Project_Id
741 is
742 Data : constant Project_Data := Projects.Table (Project);
743 List : Project_List := Data.Imported_Projects;
744
745 begin
746 -- First check if it is the name of a modified project
747
748 if Data.Modifies /= No_Project
749 and then Projects.Table (Data.Modifies).Name = With_Name
750 then
751 return Data.Modifies;
752
753 else
754 -- Then check the name of each imported project
755
756 while List /= Empty_Project_List
757 and then
758 Projects.Table
759 (Project_Lists.Table (List).Project).Name /= With_Name
760
761 loop
762 List := Project_Lists.Table (List).Next;
763 end loop;
764
765 pragma Assert
766 (List /= Empty_Project_List,
767 "project not found");
768
769 return Project_Lists.Table (List).Project;
770 end if;
771 end Imported_Or_Modified_Project_From;
772
773 ------------------
774 -- Package_From --
775 ------------------
776
777 function Package_From
778 (Project : Project_Id;
779 With_Name : Name_Id)
780 return Package_Id
781 is
782 Data : constant Project_Data := Projects.Table (Project);
783 Result : Package_Id := Data.Decl.Packages;
784
785 begin
786 -- Check the name of each existing package of Project
787
788 while Result /= No_Package
789 and then
790 Packages.Table (Result).Name /= With_Name
791 loop
792 Result := Packages.Table (Result).Next;
793 end loop;
794
795 if Result = No_Package then
796 -- Should never happen
797 Write_Line ("package """ & Get_Name_String (With_Name) &
798 """ not found");
799 raise Program_Error;
800
801 else
802 return Result;
803 end if;
804 end Package_From;
805
806 -------------
807 -- Process --
808 -------------
809
810 procedure Process
811 (Project : out Project_Id;
812 From_Project_Node : Project_Node_Id;
813 Report_Error : Put_Line_Access)
814 is
815 begin
816 Error_Report := Report_Error;
817
818 -- Make sure there is no projects in the data structure
819
820 Projects.Set_Last (No_Project);
821 Processed_Projects.Reset;
822
823 -- And process the main project and all of the projects it depends on,
824 -- recursively
825
826 Recursive_Process
827 (Project => Project,
828 From_Project_Node => From_Project_Node,
829 Modified_By => No_Project);
830
831 if Errout.Total_Errors_Detected > 0 then
832 Project := No_Project;
833 end if;
834
835 if Project /= No_Project then
836 Check (Project);
837 end if;
838 end Process;
839
840 -------------------------------
841 -- Process_Declarative_Items --
842 -------------------------------
843
844 procedure Process_Declarative_Items
845 (Project : Project_Id;
846 From_Project_Node : Project_Node_Id;
847 Pkg : Package_Id;
848 Item : Project_Node_Id) is
849
850 Current_Declarative_Item : Project_Node_Id := Item;
851
852 Current_Item : Project_Node_Id := Empty_Node;
853
854 begin
855 -- For each declarative item
856
857 while Current_Declarative_Item /= Empty_Node loop
858
859 -- Get its data
860
861 Current_Item := Current_Item_Node (Current_Declarative_Item);
862
863 -- And set Current_Declarative_Item to the next declarative item
864 -- ready for the next iteration
865
866 Current_Declarative_Item := Next_Declarative_Item
867 (Current_Declarative_Item);
868
869 case Kind_Of (Current_Item) is
870
871 when N_Package_Declaration =>
872 Packages.Increment_Last;
873
874 declare
875 New_Pkg : constant Package_Id := Packages.Last;
876 The_New_Package : Package_Element;
877
878 Project_Of_Renamed_Package : constant Project_Node_Id :=
879 Project_Of_Renamed_Package_Of
880 (Current_Item);
881
882 begin
883 The_New_Package.Name := Name_Of (Current_Item);
884
885 if Pkg /= No_Package then
886 The_New_Package.Next :=
887 Packages.Table (Pkg).Decl.Packages;
888 Packages.Table (Pkg).Decl.Packages := New_Pkg;
889 else
890 The_New_Package.Next :=
891 Projects.Table (Project).Decl.Packages;
892 Projects.Table (Project).Decl.Packages := New_Pkg;
893 end if;
894
895 Packages.Table (New_Pkg) := The_New_Package;
896
897 if Project_Of_Renamed_Package /= Empty_Node then
898
899 -- Renamed package
900
901 declare
902 Project_Name : constant Name_Id :=
903 Name_Of
904 (Project_Of_Renamed_Package);
905
906 Renamed_Project : constant Project_Id :=
907 Imported_Or_Modified_Project_From
908 (Project, Project_Name);
909
910 Renamed_Package : constant Package_Id :=
911 Package_From
912 (Renamed_Project,
913 Name_Of (Current_Item));
914
915 begin
916 Packages.Table (New_Pkg).Decl :=
917 Packages.Table (Renamed_Package).Decl;
918 end;
919
920 else
921 -- Set the default values of the attributes
922
923 Add_Attributes
924 (Packages.Table (New_Pkg).Decl,
925 Package_Attributes.Table
926 (Package_Id_Of (Current_Item)).First_Attribute);
927
928 Process_Declarative_Items
929 (Project => Project,
930 From_Project_Node => From_Project_Node,
931 Pkg => New_Pkg,
932 Item => First_Declarative_Item_Of
933 (Current_Item));
934 end if;
935
936 end;
937
938 when N_String_Type_Declaration =>
939
940 -- There is nothing to process
941
942 null;
943
944 when N_Attribute_Declaration |
945 N_Typed_Variable_Declaration |
946 N_Variable_Declaration =>
947
948 pragma Assert (Expression_Of (Current_Item) /= Empty_Node,
949 "no expression for an object declaration");
950
951 declare
952 New_Value : constant Variable_Value :=
953 Expression
954 (Project => Project,
955 From_Project_Node => From_Project_Node,
956 Pkg => Pkg,
957 First_Term =>
958 Tree.First_Term (Expression_Of
959 (Current_Item)),
960 Kind =>
961 Expression_Kind_Of (Current_Item));
962
963 The_Variable : Variable_Id := No_Variable;
964
965 Current_Item_Name : constant Name_Id :=
966 Name_Of (Current_Item);
967
968 begin
969 if Kind_Of (Current_Item) = N_Typed_Variable_Declaration then
970
971 if String_Equal (New_Value.Value, Empty_String) then
972 Error_Msg_Name_1 := Name_Of (Current_Item);
973
974 if Error_Report = null then
975 Error_Msg
976 ("no value defined for %",
977 Location_Of (Current_Item));
978
979 else
980 Error_Report
981 ("no value defined for " &
982 Get_Name_String (Error_Msg_Name_1),
983 Project);
984 end if;
985
986 else
987 declare
988 Current_String : Project_Node_Id :=
989 First_Literal_String
990 (String_Type_Of
991 (Current_Item));
992
993 begin
994 while Current_String /= Empty_Node
995 and then not String_Equal
996 (String_Value_Of (Current_String),
997 New_Value.Value)
998 loop
999 Current_String :=
1000 Next_Literal_String (Current_String);
1001 end loop;
1002
1003 if Current_String = Empty_Node then
1004 String_To_Name_Buffer (New_Value.Value);
1005 Error_Msg_Name_1 := Name_Find;
1006 Error_Msg_Name_2 := Name_Of (Current_Item);
1007
1008 if Error_Report = null then
1009 Error_Msg
1010 ("value { is illegal for typed string %",
1011 Location_Of (Current_Item));
1012
1013 else
1014 Error_Report
1015 ("value """ &
1016 Get_Name_String (Error_Msg_Name_1) &
1017 """ is illegal for typed string """ &
1018 Get_Name_String (Error_Msg_Name_2) &
1019 """",
1020 Project);
1021 end if;
1022 end if;
1023 end;
1024 end if;
1025 end if;
1026
1027 if Kind_Of (Current_Item) /= N_Attribute_Declaration
1028 or else
1029 Associative_Array_Index_Of (Current_Item) = No_String
1030 then
1031 -- Usual case
1032
1033 -- Code below really needs more comments ???
1034
1035 if Kind_Of (Current_Item) = N_Attribute_Declaration then
1036 if Pkg /= No_Package then
1037 The_Variable :=
1038 Packages.Table (Pkg).Decl.Attributes;
1039
1040 else
1041 The_Variable :=
1042 Projects.Table (Project).Decl.Attributes;
1043 end if;
1044
1045 else
1046 if Pkg /= No_Package then
1047 The_Variable :=
1048 Packages.Table (Pkg).Decl.Variables;
1049
1050 else
1051 The_Variable :=
1052 Projects.Table (Project).Decl.Variables;
1053 end if;
1054
1055 end if;
1056
1057 while
1058 The_Variable /= No_Variable
1059 and then
1060 Variable_Elements.Table (The_Variable).Name /=
1061 Current_Item_Name
1062 loop
1063 The_Variable :=
1064 Variable_Elements.Table (The_Variable).Next;
1065 end loop;
1066
1067 if The_Variable = No_Variable then
1068 pragma Assert
1069 (Kind_Of (Current_Item) /= N_Attribute_Declaration,
1070 "illegal attribute declaration");
1071
1072 Variable_Elements.Increment_Last;
1073 The_Variable := Variable_Elements.Last;
1074
1075 if Pkg /= No_Package then
1076 Variable_Elements.Table (The_Variable) :=
1077 (Next =>
1078 Packages.Table (Pkg).Decl.Variables,
1079 Name => Current_Item_Name,
1080 Value => New_Value);
1081 Packages.Table (Pkg).Decl.Variables := The_Variable;
1082
1083 else
1084 Variable_Elements.Table (The_Variable) :=
1085 (Next =>
1086 Projects.Table (Project).Decl.Variables,
1087 Name => Current_Item_Name,
1088 Value => New_Value);
1089 Projects.Table (Project).Decl.Variables :=
1090 The_Variable;
1091 end if;
1092
1093 else
1094 Variable_Elements.Table (The_Variable).Value :=
1095 New_Value;
1096
1097 end if;
1098
1099 else
1100 -- Associative array attribute
1101
1102 String_To_Name_Buffer
1103 (Associative_Array_Index_Of (Current_Item));
1104
1105 if Case_Insensitive (Current_Item) then
1106 GNAT.Case_Util.To_Lower (Name_Buffer (1 .. Name_Len));
1107 end if;
1108
1109 declare
1110 The_Array : Array_Id;
1111
1112 The_Array_Element : Array_Element_Id :=
1113 No_Array_Element;
1114
1115 Index_Name : constant Name_Id := Name_Find;
1116
1117 begin
1118
1119 if Pkg /= No_Package then
1120 The_Array := Packages.Table (Pkg).Decl.Arrays;
1121
1122 else
1123 The_Array := Projects.Table (Project).Decl.Arrays;
1124 end if;
1125
1126 while
1127 The_Array /= No_Array
1128 and then Arrays.Table (The_Array).Name /=
1129 Current_Item_Name
1130 loop
1131 The_Array := Arrays.Table (The_Array).Next;
1132 end loop;
1133
1134 if The_Array = No_Array then
1135 Arrays.Increment_Last;
1136 The_Array := Arrays.Last;
1137
1138 if Pkg /= No_Package then
1139 Arrays.Table (The_Array) :=
1140 (Name => Current_Item_Name,
1141 Value => No_Array_Element,
1142 Next => Packages.Table (Pkg).Decl.Arrays);
1143 Packages.Table (Pkg).Decl.Arrays := The_Array;
1144
1145 else
1146 Arrays.Table (The_Array) :=
1147 (Name => Current_Item_Name,
1148 Value => No_Array_Element,
1149 Next =>
1150 Projects.Table (Project).Decl.Arrays);
1151 Projects.Table (Project).Decl.Arrays :=
1152 The_Array;
1153 end if;
1154
1155 else
1156 The_Array_Element := Arrays.Table (The_Array).Value;
1157 end if;
1158
1159 while The_Array_Element /= No_Array_Element
1160 and then
1161 Array_Elements.Table (The_Array_Element).Index /=
1162 Index_Name
1163 loop
1164 The_Array_Element :=
1165 Array_Elements.Table (The_Array_Element).Next;
1166 end loop;
1167
1168 if The_Array_Element = No_Array_Element then
1169 Array_Elements.Increment_Last;
1170 The_Array_Element := Array_Elements.Last;
1171 Array_Elements.Table (The_Array_Element) :=
1172 (Index => Index_Name,
1173 Value => New_Value,
1174 Next => Arrays.Table (The_Array).Value);
1175 Arrays.Table (The_Array).Value := The_Array_Element;
1176
1177 else
1178 Array_Elements.Table (The_Array_Element).Value :=
1179 New_Value;
1180 end if;
1181 end;
1182 end if;
1183 end;
1184
1185 when N_Case_Construction =>
1186 declare
1187 The_Project : Project_Id := Project;
1188 The_Package : Package_Id := Pkg;
1189 The_Variable : Variable_Value := Nil_Variable_Value;
1190 Case_Value : String_Id := No_String;
1191 Case_Item : Project_Node_Id := Empty_Node;
1192 Choice_String : Project_Node_Id := Empty_Node;
1193 Decl_Item : Project_Node_Id := Empty_Node;
1194
1195 begin
1196 declare
1197 Variable_Node : constant Project_Node_Id :=
1198 Case_Variable_Reference_Of
1199 (Current_Item);
1200
1201 Var_Id : Variable_Id := No_Variable;
1202 Name : Name_Id := No_Name;
1203
1204 begin
1205 if Project_Node_Of (Variable_Node) /= Empty_Node then
1206 Name := Name_Of (Project_Node_Of (Variable_Node));
1207 The_Project :=
1208 Imported_Or_Modified_Project_From (Project, Name);
1209 end if;
1210
1211 if Package_Node_Of (Variable_Node) /= Empty_Node then
1212 Name := Name_Of (Package_Node_Of (Variable_Node));
1213 The_Package := Package_From (The_Project, Name);
1214 end if;
1215
1216 Name := Name_Of (Variable_Node);
1217
1218 if The_Package /= No_Package then
1219 Var_Id := Packages.Table (The_Package).Decl.Variables;
1220 Name := Name_Of (Variable_Node);
1221 while Var_Id /= No_Variable
1222 and then
1223 Variable_Elements.Table (Var_Id).Name /= Name
1224 loop
1225 Var_Id := Variable_Elements.Table (Var_Id).Next;
1226 end loop;
1227 end if;
1228
1229 if Var_Id = No_Variable
1230 and then Package_Node_Of (Variable_Node) = Empty_Node
1231 then
1232 Var_Id := Projects.Table (The_Project).Decl.Variables;
1233 while Var_Id /= No_Variable
1234 and then
1235 Variable_Elements.Table (Var_Id).Name /= Name
1236 loop
1237 Var_Id := Variable_Elements.Table (Var_Id).Next;
1238 end loop;
1239 end if;
1240
1241 if Var_Id = No_Variable then
1242
1243 -- Should never happen
1244
1245 Write_Line ("variable """ &
1246 Get_Name_String (Name) &
1247 """ not found");
1248 raise Program_Error;
1249 end if;
1250
1251 The_Variable := Variable_Elements.Table (Var_Id).Value;
1252
1253 if The_Variable.Kind /= Single then
1254
1255 -- Should never happen
1256
1257 Write_Line ("variable""" &
1258 Get_Name_String (Name) &
1259 """ is not a single string variable");
1260 raise Program_Error;
1261 end if;
1262
1263 Case_Value := The_Variable.Value;
1264 end;
1265
1266 Case_Item := First_Case_Item_Of (Current_Item);
1267 Case_Item_Loop :
1268 while Case_Item /= Empty_Node loop
1269 Choice_String := First_Choice_Of (Case_Item);
1270
1271 if Choice_String = Empty_Node then
1272 Decl_Item := First_Declarative_Item_Of (Case_Item);
1273 exit Case_Item_Loop;
1274 end if;
1275
1276 Choice_Loop :
1277 while Choice_String /= Empty_Node loop
1278 if String_Equal (Case_Value,
1279 String_Value_Of (Choice_String))
1280 then
1281 Decl_Item :=
1282 First_Declarative_Item_Of (Case_Item);
1283 exit Case_Item_Loop;
1284 end if;
1285
1286 Choice_String :=
1287 Next_Literal_String (Choice_String);
1288 end loop Choice_Loop;
1289 Case_Item := Next_Case_Item (Case_Item);
1290 end loop Case_Item_Loop;
1291
1292 if Decl_Item /= Empty_Node then
1293 Process_Declarative_Items
1294 (Project => Project,
1295 From_Project_Node => From_Project_Node,
1296 Pkg => Pkg,
1297 Item => Decl_Item);
1298 end if;
1299 end;
1300
1301 when others =>
1302
1303 -- Should never happen
1304
1305 Write_Line ("Illegal declarative item: " &
1306 Project_Node_Kind'Image (Kind_Of (Current_Item)));
1307 raise Program_Error;
1308 end case;
1309 end loop;
1310 end Process_Declarative_Items;
1311
1312 ---------------------
1313 -- Recursive_Check --
1314 ---------------------
1315
1316 procedure Recursive_Check (Project : Project_Id) is
1317 Data : Project_Data;
1318 Imported_Project_List : Project_List := Empty_Project_List;
1319
1320 begin
1321 -- Do nothing if Project is No_Project, or Project has already
1322 -- been marked as checked.
1323
1324 if Project /= No_Project
1325 and then not Projects.Table (Project).Checked
1326 then
1327 Data := Projects.Table (Project);
1328
1329 -- Call itself for a possible modified project.
1330 -- (if there is no modified project, then nothing happens).
1331
1332 Recursive_Check (Data.Modifies);
1333
1334 -- Call itself for all imported projects
1335
1336 Imported_Project_List := Data.Imported_Projects;
1337 while Imported_Project_List /= Empty_Project_List loop
1338 Recursive_Check
1339 (Project_Lists.Table (Imported_Project_List).Project);
1340 Imported_Project_List :=
1341 Project_Lists.Table (Imported_Project_List).Next;
1342 end loop;
1343
1344 -- Mark project as checked
1345
1346 Projects.Table (Project).Checked := True;
1347
1348 if Opt.Verbose_Mode then
1349 Write_Str ("Checking project file """);
1350 Write_Str (Get_Name_String (Data.Name));
1351 Write_Line ("""");
1352 end if;
1353
1354 Prj.Nmsc.Ada_Check (Project, Error_Report);
1355 end if;
1356 end Recursive_Check;
1357
1358 -----------------------
1359 -- Recursive_Process --
1360 -----------------------
1361
1362 procedure Recursive_Process
1363 (Project : out Project_Id;
1364 From_Project_Node : Project_Node_Id;
1365 Modified_By : Project_Id)
1366 is
1367 With_Clause : Project_Node_Id;
1368
1369 begin
1370 if From_Project_Node = Empty_Node then
1371 Project := No_Project;
1372
1373 else
1374 declare
1375 Processed_Data : Project_Data := Empty_Project;
1376 Imported : Project_List := Empty_Project_List;
1377 Declaration_Node : Project_Node_Id := Empty_Node;
1378 Name : constant Name_Id :=
1379 Name_Of (From_Project_Node);
1380
1381 begin
1382 Project := Processed_Projects.Get (Name);
1383
1384 if Project /= No_Project then
1385 return;
1386 end if;
1387
1388 Projects.Increment_Last;
1389 Project := Projects.Last;
1390 Processed_Projects.Set (Name, Project);
1391
1392 Processed_Data.Name := Name;
1393 Processed_Data.Path_Name := Path_Name_Of (From_Project_Node);
1394 Processed_Data.Location := Location_Of (From_Project_Node);
1395 Processed_Data.Directory := Directory_Of (From_Project_Node);
1396 Processed_Data.Modified_By := Modified_By;
1397 Processed_Data.Naming := Standard_Naming_Data;
1398
1399 Add_Attributes (Processed_Data.Decl, Attribute_First);
1400 With_Clause := First_With_Clause_Of (From_Project_Node);
1401
1402 while With_Clause /= Empty_Node loop
1403 declare
1404 New_Project : Project_Id;
1405 New_Data : Project_Data;
1406
1407 begin
1408 Recursive_Process
1409 (Project => New_Project,
1410 From_Project_Node => Project_Node_Of (With_Clause),
1411 Modified_By => No_Project);
1412 New_Data := Projects.Table (New_Project);
1413
1414 -- If we were the first project to import it,
1415 -- set First_Referred_By to us.
1416
1417 if New_Data.First_Referred_By = No_Project then
1418 New_Data.First_Referred_By := Project;
1419 Projects.Table (New_Project) := New_Data;
1420 end if;
1421
1422 -- Add this project to our list of imported projects
1423
1424 Project_Lists.Increment_Last;
1425 Project_Lists.Table (Project_Lists.Last) :=
1426 (Project => New_Project, Next => Empty_Project_List);
1427
1428 -- Imported is the id of the last imported project.
1429 -- If it is nil, then this imported project is our first.
1430
1431 if Imported = Empty_Project_List then
1432 Processed_Data.Imported_Projects := Project_Lists.Last;
1433
1434 else
1435 Project_Lists.Table (Imported).Next := Project_Lists.Last;
1436 end if;
1437
1438 Imported := Project_Lists.Last;
1439
1440 With_Clause := Next_With_Clause_Of (With_Clause);
1441 end;
1442 end loop;
1443
1444 Declaration_Node := Project_Declaration_Of (From_Project_Node);
1445
1446 Recursive_Process
1447 (Project => Processed_Data.Modifies,
1448 From_Project_Node => Modified_Project_Of (Declaration_Node),
1449 Modified_By => Project);
1450
1451 Projects.Table (Project) := Processed_Data;
1452
1453 Process_Declarative_Items
1454 (Project => Project,
1455 From_Project_Node => From_Project_Node,
1456 Pkg => No_Package,
1457 Item => First_Declarative_Item_Of
1458 (Declaration_Node));
1459
1460 end;
1461 end if;
1462 end Recursive_Process;
1463
1464 end Prj.Proc;
Mirror of the offical gcc git repository hosted at gcc.gnu.org