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