| blob | 48b57aa454bb32d731eb9a81d7e41f51b6ead59c |
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . P A R T --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2013, 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 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
52 ------------------------------------
53 -- Local Packages and Subprograms --
54 ------------------------------------
66 -- Information about an imported project, to be put in table Withs below
75 -- Table used to store temporarily paths and locations of imported
76 -- projects. These imported projects will be effectively parsed later: just
77 -- before parsing the current project for the non limited withed projects,
78 -- after getting its name; after complete parsing of the current project
79 -- for the limited withed projects.
95 -- This table is used to detect circular dependencies
96 -- for imported and extended projects and to get the project ids of
97 -- limited imported projects when there is a circularity with at least
98 -- one limited imported project file.
107 -- Hash table to store the node ids of projects for which a virtual
108 -- extending project need to be created. The corresponding value is the
109 -- head of a list of WITH clauses corresponding to the context of the
110 -- enclosing EXTEND ALL projects. Note: Default_Element is Project_Node_
111 -- High_Bound because we want Empty_Node to be a possible value.
120 -- Hash table to store the project process when looking for project that
121 -- need to have a virtual extending project, to avoid processing the same
122 -- project twice.
124 function Has_Circular_Dependencies
128 -- Check for a circular dependency in the loaded project.
129 -- Generates an error message in such a case.
131 procedure Read_Project_Qualifier
137 -- Check if there is a qualifier before the reserved word "project"
139 -- Hash table to cache project path to avoid looking for them on the path
141 procedure Check_Extending_All_Imports
145 -- Check that a non extending-all project does not import an
146 -- extending-all project.
148 procedure Check_Aggregate_Imports
152 -- Check that an aggregate project only imports abstract projects
154 procedure Check_Import_Aggregate
158 -- Check that a non aggregate project does not import an aggregate project
160 procedure Create_Virtual_Extending_Project
165 -- Create a virtual extending project of For_Project. Main_Project is
166 -- the extending all project. Extension_Withs is the head of a WITH clause
167 -- list to be added to the created virtual project.
168 --
169 -- The String_Value_Of is not set for the automatically added with
170 -- clause and keeps the default value of No_Name. This enables Prj.PP
171 -- to skip these automatically added with clauses to be processed.
173 procedure Look_For_Virtual_Projects_For
177 -- Look for projects that need to have a virtual extending project.
178 -- This procedure is recursive. If called with Potentially_Virtual set to
179 -- True, then Proj may need an virtual extending project; otherwise it
180 -- does not (because it is already extended), but other projects that it
181 -- imports may need to be virtually extended.
184 -- Type of parameter From_Extended for procedures Parse_Single_Project and
185 -- Post_Parse_Context_Clause. Extending_All means that we are parsing the
186 -- tree rooted at an extending all project.
188 procedure Parse_Single_Project
202 -- Parse a project file. This is a recursive procedure: it calls itself for
203 -- imported and extended projects. When From_Extended is not None, if the
204 -- project has already been parsed and is an extended project A, return the
205 -- ultimate (not extended) project that extends A. When In_Limited is True,
206 -- the importing path includes at least one "limited with". When parsing
207 -- configuration projects, do not allow a depth > 1.
208 --
209 -- Is_Config_File should be set to True if the project represents a config
210 -- file (.cgpr) since some specific checks apply.
211 --
212 -- If Implicit_Project is True, change the Directory of the project node
213 -- to be the Current_Dir. Recursive calls to Parse_Single_Project are
214 -- always done with the default False value for Implicit_Project.
216 procedure Pre_Parse_Context_Clause
221 -- Parse the context clause of a project. Store the paths and locations of
222 -- the imported projects in table Withs. Does nothing if there is no
223 -- context clause (if the current token is not "with" or "limited" followed
224 -- by "with").
225 -- Is_Config_File should be set to True if the project represents a config
226 -- file (.cgpr) since some specific checks apply.
228 procedure Post_Parse_Context_Clause
241 -- Parse the imported projects that have been stored in table Withs, if
242 -- any. From_Extended is used for the call to Parse_Single_Project below.
243 --
244 -- When In_Limited is True, the importing path includes at least one
245 -- "limited with". When Limited_Withs is False, only non limited withed
246 -- projects are parsed. When Limited_Withs is True, only limited withed
247 -- projects are parsed.
248 --
249 -- Is_Config_File should be set to True if the project represents a config
250 -- file (.cgpr) since some specific checks apply.
252 function Project_Name_From
255 -- Returns the name of the project that corresponds to its path name.
256 -- Returns No_Name if the path name is invalid, because the corresponding
257 -- project name does not have the syntax of an ada identifier.
259 function Copy_With_Clause
263 -- Return a copy of With_Clause in In_Tree, whose Next_With_Clause is the
264 -- indicated one.
266 ----------------------
267 -- Copy_With_Clause --
268 ----------------------
270 function Copy_With_Clause
274 is
277 begin
289 --------------------------------------
290 -- Create_Virtual_Extending_Project --
291 --------------------------------------
293 procedure Create_Virtual_Extending_Project
298 is
301 Virtual_Prefix &
303 -- The name of the virtual extending project
306 -- Virtual extending project name id
309 -- Fake path name of the virtual extending project. The directory is
310 -- the same directory as the extending all project.
312 -- The source of the virtual extending project is something like:
314 -- project V$<project name> extends <project path> is
316 -- for Source_Dirs use ();
318 -- end V$<project name>;
320 -- The project directory cannot be specified during parsing; it will be
321 -- put directly in the virtual extending project data during processing.
323 -- Nodes that made up the virtual extending project
327 Default_Project_Node
331 Default_Project_Node
334 Default_Project_Node
337 Default_Project_Node
340 Default_Project_Node
343 Default_Project_Node
346 begin
347 -- Get the virtual path name
354 loop
359 Virtual_Name;
363 -- Get the virtual name id
369 Virtual_Project := Create_Project
377 -- Add a WITH clause to the main project to import the newly created
378 -- virtual extending project.
383 Set_Next_With_Clause_Of
387 -- Copy with clauses for projects imported by the extending-all project
389 declare
393 begin
395 New_With_Clause :=
404 -- Virtual project node
406 Set_Location_Of
408 Set_Extended_Project_Path_Of
411 -- Project declaration
413 Set_First_Declarative_Item_Of
417 -- Source_Dirs declaration
419 Set_Current_Item_Node
422 -- Source_Dirs attribute
425 Set_Expression_Of
428 -- Source_Dirs expression
432 -- Source_Dirs term
436 -- Source_Dirs empty list: nothing to do
439 -----------------------------------
440 -- Look_For_Virtual_Projects_For --
441 -----------------------------------
444 -- Head of the current EXTENDS ALL imports list. When creating virtual
445 -- projects for an EXTENDS ALL, we import in each virtual project all
446 -- of the projects that appear in WITH clauses of the extending projects.
447 -- This ensures that virtual projects share a consistent environment (in
448 -- particular if a project imported by one of the extending projects
449 -- replaces some runtime units).
451 procedure Look_For_Virtual_Projects_For
455 is
457 -- Node for the project declaration of Proj
460 -- Node for a with clause of Proj
463 -- Node for a project imported by Proj
466 -- Node for the eventual project extended by Proj
469 -- Set True if Proj is an EXTENDS ALL project
473 begin
474 -- Nothing to do if Proj is undefined or has already been processed
478 -- Make sure the project will not be processed again
489 -- If this is a project that may need a virtual extending project
490 -- and it is not itself an extending project, put it in the list.
496 -- Now check the projects it imports
503 Look_For_Virtual_Projects_For
509 -- This is an EXTENDS ALL project: prepend each of its WITH
510 -- clauses to the currently active list of extension deps.
512 Extension_Withs :=
519 -- Check also the eventual project extended by Proj. As this project
520 -- is already extended, call recursively with Potentially_Virtual
521 -- being False.
523 Look_For_Virtual_Projects_For
530 -----------
531 -- Parse --
532 -----------
534 procedure Parse
546 is
551 Osint.To_Canonical_File_Spec
555 begin
565 end if;
567 Project := Empty_Node;
569 Find_Project (Env.Project_Path,
570 Project_File_Name => Real_Project_File_Name.all,
571 Directory => Current_Directory,
572 Path => Path_Name_Id);
573 Free (Real_Project_File_Name);
575 if Errout_Handling /= Never_Finalize then
576 Prj.Err.Initialize;
577 end if;
579 Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
580 Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
582 if Path_Name_Id = No_Path then
583 declare
584 P : String_Access;
585 begin
586 Get_Path (Env.Project_Path, Path => P);
588 Prj.Com.Fail
589 ("project file """
590 & Project_File_Name
591 & """ not found in "
592 & P.all);
593 Project := Empty_Node;
594 return;
595 end;
596 end if;
598 -- Parse the main project file
600 begin
601 Parse_Single_Project
602 (In_Tree => In_Tree,
603 Project => Project,
604 Extends_All => Dummy,
605 Path_Name_Id => Path_Name_Id,
606 Extended => False,
607 From_Extended => None,
608 In_Limited => False,
609 Packages_To_Check => Packages_To_Check,
610 Depth => 0,
611 Current_Dir => Current_Directory,
612 Is_Config_File => Is_Config_File,
613 Env => Env,
614 Implicit_Project => Implicit_Project);
616 exception
617 when Types.Unrecoverable_Error =>
619 -- Unrecoverable_Error is raised when a line is too long.
620 -- A meaningful error message will be displayed later.
622 Project := Empty_Node;
623 end;
625 -- If Project is an extending-all project, create the eventual
626 -- virtual extending projects and check that there are no illegally
627 -- imported projects.
629 if Present (Project)
630 and then Is_Extending_All (Project, In_Tree)
631 then
632 -- First look for projects that potentially need a virtual
633 -- extending project.
635 Virtual_Hash.Reset;
636 Processed_Hash.Reset;
638 -- Mark the extending all project as processed, to avoid checking
639 -- the imported projects in case of a "limited with" on this
640 -- extending all project.
642 Processed_Hash.Set (Project, True);
644 declare
645 Declaration : constant Project_Node_Id :=
646 Project_Declaration_Of (Project, In_Tree);
647 begin
648 Extension_Withs := First_With_Clause_Of (Project, In_Tree);
649 Look_For_Virtual_Projects_For
650 (Extended_Project_Of (Declaration, In_Tree), In_Tree,
651 Potentially_Virtual => False);
652 end;
654 -- Now, check the projects directly imported by the main project.
655 -- Remove from the potentially virtual any project extended by one
656 -- of these imported projects.
658 declare
659 With_Clause : Project_Node_Id;
660 Imported : Project_Node_Id := Empty_Node;
661 Declaration : Project_Node_Id := Empty_Node;
663 begin
664 With_Clause := First_With_Clause_Of (Project, In_Tree);
665 while Present (With_Clause) loop
666 Imported := Project_Node_Of (With_Clause, In_Tree);
668 if Present (Imported) then
669 Declaration := Project_Declaration_Of (Imported, In_Tree);
671 if Extended_Project_Of (Declaration, In_Tree) /=
672 Empty_Node
673 then
674 loop
675 Imported :=
676 Extended_Project_Of (Declaration, In_Tree);
677 exit when No (Imported);
678 Virtual_Hash.Remove (Imported);
679 Declaration :=
680 Project_Declaration_Of (Imported, In_Tree);
681 end loop;
682 end if;
683 end if;
685 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
686 end loop;
687 end;
689 -- Now create all the virtual extending projects
691 declare
692 Proj : Project_Node_Id := Empty_Node;
693 Withs : Project_Node_Id;
694 begin
695 Virtual_Hash.Get_First (Proj, Withs);
696 while Withs /= Project_Node_High_Bound loop
697 Create_Virtual_Extending_Project
698 (Proj, Project, Withs, In_Tree);
699 Virtual_Hash.Get_Next (Proj, Withs);
700 end loop;
701 end;
702 end if;
704 -- If there were any kind of error during the parsing, serious
705 -- or not, then the parsing fails.
707 if Total_Errors_Detected > 0 then
708 Project := Empty_Node;
709 end if;
711 case Errout_Handling is
712 when Always_Finalize =>
713 Prj.Err.Finalize;
715 -- Reinitialize to avoid duplicate warnings later on
716 Prj.Err.Initialize;
718 when Finalize_If_Error =>
719 if No (Project) then
720 Prj.Err.Finalize;
721 Prj.Err.Initialize;
722 end if;
724 when Never_Finalize =>
725 null;
726 end case;
728 exception
729 when X : others =>
731 -- Internal error
733 Write_Line (Exception_Information (X));
734 Write_Str ("Exception ");
735 Write_Str (Exception_Name (X));
736 Write_Line (" raised, while processing project file");
737 Project := Empty_Node;
738 end Parse;
740 ------------------------------
741 -- Pre_Parse_Context_Clause --
742 ------------------------------
744 procedure Pre_Parse_Context_Clause
745 (In_Tree : Project_Node_Tree_Ref;
746 Context_Clause : out With_Id;
747 Is_Config_File : Boolean;
748 Flags : Processing_Flags)
749 is
750 Current_With_Clause : With_Id := No_With;
751 Limited_With : Boolean := False;
752 Current_With : With_Record;
753 Current_With_Node : Project_Node_Id := Empty_Node;
755 begin
756 -- Assume no context clause
758 Context_Clause := No_With;
759 With_Loop :
761 -- If Token is not WITH or LIMITED, there is no context clause, or we
762 -- have exhausted the with clauses.
764 while Token = Tok_With or else Token = Tok_Limited loop
765 Current_With_Node :=
766 Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree);
767 Limited_With := Token = Tok_Limited;
769 if Is_Config_File then
770 Error_Msg
771 (Flags,
772 "configuration project cannot import " &
773 "other configuration projects",
774 Token_Ptr);
775 end if;
777 if Limited_With then
778 Scan (In_Tree); -- past LIMITED
779 Expect (Tok_With, "WITH");
780 exit With_Loop when Token /= Tok_With;
781 end if;
783 Comma_Loop :
784 loop
785 Scan (In_Tree); -- past WITH or ","
787 Expect (Tok_String_Literal, "literal string");
789 if Token /= Tok_String_Literal then
790 return;
791 end if;
793 -- Store path and location in table Withs
795 Current_With :=
796 (Path => Path_Name_Type (Token_Name),
797 Location => Token_Ptr,
798 Limited_With => Limited_With,
799 Node => Current_With_Node,
800 Next => No_With);
802 Withs.Increment_Last;
803 Withs.Table (Withs.Last) := Current_With;
805 if Current_With_Clause = No_With then
806 Context_Clause := Withs.Last;
808 else
809 Withs.Table (Current_With_Clause).Next := Withs.Last;
810 end if;
812 Current_With_Clause := Withs.Last;
814 Scan (In_Tree);
816 if Token = Tok_Semicolon then
817 Set_End_Of_Line (Current_With_Node);
818 Set_Previous_Line_Node (Current_With_Node);
820 -- End of (possibly multiple) with clause;
822 Scan (In_Tree); -- past semicolon
823 exit Comma_Loop;
825 elsif Token = Tok_Comma then
826 Set_Is_Not_Last_In_List (Current_With_Node, In_Tree);
828 else
829 Error_Msg (Flags, "expected comma or semi colon", Token_Ptr);
830 exit Comma_Loop;
831 end if;
833 Current_With_Node :=
834 Default_Project_Node
835 (Of_Kind => N_With_Clause, In_Tree => In_Tree);
836 end loop Comma_Loop;
837 end loop With_Loop;
838 end Pre_Parse_Context_Clause;
840 -------------------------------
841 -- Post_Parse_Context_Clause --
842 -------------------------------
844 procedure Post_Parse_Context_Clause
845 (Context_Clause : With_Id;
846 In_Tree : Project_Node_Tree_Ref;
847 In_Limited : Boolean;
848 Limited_Withs : Boolean;
849 Imported_Projects : in out Project_Node_Id;
850 Project_Directory : Path_Name_Type;
851 From_Extended : Extension_Origin;
852 Packages_To_Check : String_List_Access;
853 Depth : Natural;
854 Current_Dir : String;
855 Is_Config_File : Boolean;
856 Env : in out Environment)
857 is
858 Current_With_Clause : With_Id := Context_Clause;
860 Current_Project : Project_Node_Id := Imported_Projects;
861 Previous_Project : Project_Node_Id := Empty_Node;
862 Next_Project : Project_Node_Id := Empty_Node;
864 Project_Directory_Path : constant String :=
865 Get_Name_String (Project_Directory);
867 Current_With : With_Record;
868 Extends_All : Boolean := False;
869 Imported_Path_Name_Id : Path_Name_Type;
871 begin
872 -- Set Current_Project to the last project in the current list, if the
873 -- list is not empty.
875 if Present (Current_Project) then
876 while
877 Present (Next_With_Clause_Of (Current_Project, In_Tree))
878 loop
879 Current_Project := Next_With_Clause_Of (Current_Project, In_Tree);
880 end loop;
881 end if;
883 while Current_With_Clause /= No_With loop
884 Current_With := Withs.Table (Current_With_Clause);
885 Current_With_Clause := Current_With.Next;
887 if Limited_Withs = Current_With.Limited_With then
888 Find_Project
889 (Env.Project_Path,
890 Project_File_Name => Get_Name_String (Current_With.Path),
891 Directory => Project_Directory_Path,
892 Path => Imported_Path_Name_Id);
894 if Imported_Path_Name_Id = No_Path then
895 if Env.Flags.Ignore_Missing_With then
896 In_Tree.Incomplete_With := True;
898 else
899 -- The project file cannot be found
901 Error_Msg_File_1 := File_Name_Type (Current_With.Path);
902 Error_Msg
903 (Env.Flags, "unknown project file: {",
904 Current_With.Location);
906 -- If this is not imported by the main project file, display
907 -- the import path.
909 if Project_Stack.Last > 1 then
910 for Index in reverse 1 .. Project_Stack.Last loop
911 Error_Msg_File_1 :=
912 File_Name_Type
913 (Project_Stack.Table (Index).Path_Name);
914 Error_Msg
916 end loop;
917 end if;
918 end if;
920 else
921 -- New with clause
923 declare
924 Resolved_Path : constant String :=
925 Normalize_Pathname
926 (Get_Name_String (Imported_Path_Name_Id),
927 Directory => Current_Dir,
928 Resolve_Links =>
929 Opt.Follow_Links_For_Files,
930 Case_Sensitive => True);
932 Withed_Project : Project_Node_Id := Empty_Node;
934 begin
935 Previous_Project := Current_Project;
937 if No (Current_Project) then
939 -- First with clause of the context clause
941 Current_Project := Current_With.Node;
942 Imported_Projects := Current_Project;
944 else
945 Next_Project := Current_With.Node;
946 Set_Next_With_Clause_Of
947 (Current_Project, In_Tree, Next_Project);
948 Current_Project := Next_Project;
949 end if;
951 Set_String_Value_Of
952 (Current_Project,
953 In_Tree,
954 Name_Id (Current_With.Path));
955 Set_Location_Of
956 (Current_Project, In_Tree, Current_With.Location);
958 -- If it is a limited with, check if we have a circularity.
959 -- If we have one, get the project id of the limited
960 -- imported project file, and do not parse it.
962 if (In_Limited or Limited_Withs)
963 and then Project_Stack.Last > 1
964 then
965 declare
966 Canonical_Path_Name : Path_Name_Type;
968 begin
969 Name_Len := Resolved_Path'Length;
970 Name_Buffer (1 .. Name_Len) := Resolved_Path;
971 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
972 Canonical_Path_Name := Name_Find;
974 for Index in 1 .. Project_Stack.Last loop
975 if Project_Stack.Table (Index).Canonical_Path_Name =
976 Canonical_Path_Name
977 then
978 -- We have found the limited imported project,
979 -- get its project id, and do not parse it.
981 Withed_Project := Project_Stack.Table (Index).Id;
982 exit;
983 end if;
984 end loop;
985 end;
986 end if;
988 -- Parse the imported project if its project id is unknown
990 if No (Withed_Project) then
991 Parse_Single_Project
992 (In_Tree => In_Tree,
993 Project => Withed_Project,
994 Extends_All => Extends_All,
995 Path_Name_Id => Imported_Path_Name_Id,
996 Extended => False,
997 From_Extended => From_Extended,
998 In_Limited => In_Limited or Limited_Withs,
999 Packages_To_Check => Packages_To_Check,
1000 Depth => Depth,
1001 Current_Dir => Current_Dir,
1002 Is_Config_File => Is_Config_File,
1003 Env => Env);
1005 else
1006 Extends_All := Is_Extending_All (Withed_Project, In_Tree);
1007 end if;
1009 if No (Withed_Project) then
1011 -- If parsing unsuccessful, remove the context clause
1013 Current_Project := Previous_Project;
1015 if No (Current_Project) then
1016 Imported_Projects := Empty_Node;
1018 else
1019 Set_Next_With_Clause_Of
1020 (Current_Project, In_Tree, Empty_Node);
1021 end if;
1022 else
1023 -- If parsing was successful, record project name and
1024 -- path name in with clause
1026 Set_Project_Node_Of
1027 (Node => Current_Project,
1028 In_Tree => In_Tree,
1029 To => Withed_Project,
1030 Limited_With => Current_With.Limited_With);
1031 Set_Name_Of
1032 (Current_Project,
1033 In_Tree,
1034 Name_Of (Withed_Project, In_Tree));
1036 Name_Len := Resolved_Path'Length;
1037 Name_Buffer (1 .. Name_Len) := Resolved_Path;
1038 Set_Path_Name_Of (Current_Project, In_Tree, Name_Find);
1040 if Extends_All then
1041 Set_Is_Extending_All (Current_Project, In_Tree);
1042 end if;
1043 end if;
1044 end;
1045 end if;
1046 end if;
1047 end loop;
1048 end Post_Parse_Context_Clause;
1050 ---------------------------------
1051 -- Check_Extending_All_Imports --
1052 ---------------------------------
1054 procedure Check_Extending_All_Imports
1055 (Flags : Processing_Flags;
1056 In_Tree : Project_Node_Tree_Ref;
1057 Project : Project_Node_Id)
1058 is
1059 With_Clause : Project_Node_Id;
1060 Imported : Project_Node_Id;
1062 begin
1063 if not Is_Extending_All (Project, In_Tree) then
1064 With_Clause := First_With_Clause_Of (Project, In_Tree);
1065 while Present (With_Clause) loop
1066 Imported := Project_Node_Of (With_Clause, In_Tree);
1068 if Is_Extending_All (With_Clause, In_Tree) then
1069 Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
1070 Error_Msg (Flags, "cannot import extending-all project %%",
1071 Token_Ptr);
1072 exit;
1073 end if;
1075 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1076 end loop;
1077 end if;
1078 end Check_Extending_All_Imports;
1080 -----------------------------
1081 -- Check_Aggregate_Imports --
1082 -----------------------------
1084 procedure Check_Aggregate_Imports
1085 (Flags : Processing_Flags;
1086 In_Tree : Project_Node_Tree_Ref;
1087 Project : Project_Node_Id)
1088 is
1089 With_Clause, Imported : Project_Node_Id;
1090 begin
1091 if Project_Qualifier_Of (Project, In_Tree) = Aggregate then
1092 With_Clause := First_With_Clause_Of (Project, In_Tree);
1094 while Present (With_Clause) loop
1095 Imported := Project_Node_Of (With_Clause, In_Tree);
1097 if Project_Qualifier_Of (Imported, In_Tree) /= Dry then
1098 Error_Msg_Name_1 := Name_Id (Path_Name_Of (Imported, In_Tree));
1099 Error_Msg (Flags, "can only import abstract projects, not %%",
1100 Token_Ptr);
1101 exit;
1102 end if;
1104 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1105 end loop;
1106 end if;
1107 end Check_Aggregate_Imports;
1109 ----------------------------
1110 -- Check_Import_Aggregate --
1111 ----------------------------
1113 procedure Check_Import_Aggregate
1114 (Flags : Processing_Flags;
1115 In_Tree : Project_Node_Tree_Ref;
1116 Project : Project_Node_Id)
1117 is
1118 With_Clause : Project_Node_Id;
1119 Imported : Project_Node_Id;
1121 begin
1122 if Project_Qualifier_Of (Project, In_Tree) /= Aggregate then
1123 With_Clause := First_With_Clause_Of (Project, In_Tree);
1124 while Present (With_Clause) loop
1125 Imported := Project_Node_Of (With_Clause, In_Tree);
1127 if Project_Qualifier_Of (Imported, In_Tree) = Aggregate then
1128 Error_Msg_Name_1 := Name_Id (Path_Name_Of (Imported, In_Tree));
1129 Error_Msg
1130 (Flags, "cannot import aggregate project %%", Token_Ptr);
1131 exit;
1132 end if;
1134 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1135 end loop;
1136 end if;
1137 end Check_Import_Aggregate;
1139 ----------------------------
1140 -- Read_Project_Qualifier --
1141 ----------------------------
1143 procedure Read_Project_Qualifier
1144 (Flags : Processing_Flags;
1145 In_Tree : Project_Node_Tree_Ref;
1146 Is_Config_File : Boolean;
1147 Qualifier_Location : out Source_Ptr;
1148 Project : Project_Node_Id)
1149 is
1150 Proj_Qualifier : Project_Qualifier := Unspecified;
1151 begin
1152 Qualifier_Location := Token_Ptr;
1154 if Token = Tok_Abstract then
1155 Proj_Qualifier := Dry;
1156 Scan (In_Tree);
1158 elsif Token = Tok_Identifier then
1159 case Token_Name is
1160 when Snames.Name_Standard =>
1161 Proj_Qualifier := Standard;
1162 Scan (In_Tree);
1164 when Snames.Name_Aggregate =>
1165 Proj_Qualifier := Aggregate;
1166 Scan (In_Tree);
1168 if Token = Tok_Identifier
1169 and then Token_Name = Snames.Name_Library
1170 then
1171 Proj_Qualifier := Aggregate_Library;
1172 Scan (In_Tree);
1173 end if;
1175 when Snames.Name_Library =>
1176 Proj_Qualifier := Library;
1177 Scan (In_Tree);
1179 when Snames.Name_Configuration =>
1180 if not Is_Config_File then
1181 Error_Msg
1182 (Flags,
1183 "configuration projects cannot belong to a user" &
1184 " project tree",
1185 Token_Ptr);
1186 end if;
1188 Proj_Qualifier := Configuration;
1189 Scan (In_Tree);
1191 when others =>
1192 null;
1193 end case;
1194 end if;
1196 if Is_Config_File and then Proj_Qualifier = Unspecified then
1198 -- Set the qualifier to Configuration, even if the token doesn't
1199 -- exist in the source file itself, so that we can differentiate
1200 -- project files and configuration files later on.
1202 Proj_Qualifier := Configuration;
1203 end if;
1205 if Proj_Qualifier /= Unspecified then
1206 if Is_Config_File
1207 and then Proj_Qualifier /= Configuration
1208 then
1209 Error_Msg (Flags,
1210 "a configuration project cannot be qualified except " &
1211 "as configuration project",
1212 Qualifier_Location);
1213 end if;
1215 Set_Project_Qualifier_Of (Project, In_Tree, Proj_Qualifier);
1216 end if;
1217 end Read_Project_Qualifier;
1219 -------------------------------
1220 -- Has_Circular_Dependencies --
1221 -------------------------------
1223 function Has_Circular_Dependencies
1224 (Flags : Processing_Flags;
1225 Normed_Path_Name : Path_Name_Type;
1226 Canonical_Path_Name : Path_Name_Type) return Boolean is
1227 begin
1228 for Index in reverse 1 .. Project_Stack.Last loop
1229 exit when Project_Stack.Table (Index).Limited_With;
1231 if Canonical_Path_Name =
1232 Project_Stack.Table (Index).Canonical_Path_Name
1233 then
1234 Error_Msg (Flags, "circular dependency detected", Token_Ptr);
1235 Error_Msg_Name_1 := Name_Id (Normed_Path_Name);
1238 for Current in reverse 1 .. Project_Stack.Last loop
1239 Error_Msg_Name_1 :=
1240 Name_Id (Project_Stack.Table (Current).Path_Name);
1242 if Project_Stack.Table (Current).Canonical_Path_Name /=
1243 Canonical_Path_Name
1244 then
1245 Error_Msg
1248 else
1250 exit;
1251 end if;
1252 end loop;
1254 return True;
1255 end if;
1256 end loop;
1257 return False;
1258 end Has_Circular_Dependencies;
1260 --------------------------
1261 -- Parse_Single_Project --
1262 --------------------------
1264 procedure Parse_Single_Project
1265 (In_Tree : Project_Node_Tree_Ref;
1266 Project : out Project_Node_Id;
1267 Extends_All : out Boolean;
1268 Path_Name_Id : Path_Name_Type;
1269 Extended : Boolean;
1270 From_Extended : Extension_Origin;
1271 In_Limited : Boolean;
1272 Packages_To_Check : String_List_Access;
1273 Depth : Natural;
1274 Current_Dir : String;
1275 Is_Config_File : Boolean;
1276 Env : in out Environment;
1277 Implicit_Project : Boolean := False)
1278 is
1279 Path_Name : constant String := Get_Name_String (Path_Name_Id);
1281 Normed_Path_Name : Path_Name_Type;
1282 Canonical_Path_Name : Path_Name_Type;
1283 Resolved_Path_Name : Path_Name_Type;
1284 Project_Directory : Path_Name_Type;
1285 Project_Scan_State : Saved_Project_Scan_State;
1286 Source_Index : Source_File_Index;
1288 Extending : Boolean := False;
1290 Extended_Project : Project_Node_Id := Empty_Node;
1292 A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1293 Tree_Private_Part.Projects_Htable.Get_First
1294 (In_Tree.Projects_HT);
1296 Name_From_Path : constant Name_Id :=
1297 Project_Name_From (Path_Name, Is_Config_File => Is_Config_File);
1298 Name_Of_Project : Name_Id := No_Name;
1299 Display_Name_Of_Project : Name_Id := No_Name;
1301 Duplicated : Boolean := False;
1303 First_With : With_Id;
1304 Imported_Projects : Project_Node_Id := Empty_Node;
1306 use Tree_Private_Part;
1308 Project_Comment_State : Tree.Comment_State;
1310 Qualifier_Location : Source_Ptr;
1312 begin
1313 Extends_All := False;
1315 declare
1316 Normed_Path : constant String := Normalize_Pathname
1317 (Path_Name,
1318 Directory => Current_Dir,
1319 Resolve_Links => False,
1320 Case_Sensitive => True);
1321 Canonical_Path : constant String := Normalize_Pathname
1322 (Normed_Path,
1323 Directory => Current_Dir,
1324 Resolve_Links => Opt.Follow_Links_For_Files,
1325 Case_Sensitive => False);
1326 begin
1327 Name_Len := Normed_Path'Length;
1328 Name_Buffer (1 .. Name_Len) := Normed_Path;
1329 Normed_Path_Name := Name_Find;
1330 Name_Len := Canonical_Path'Length;
1331 Name_Buffer (1 .. Name_Len) := Canonical_Path;
1332 Canonical_Path_Name := Name_Find;
1334 if Opt.Follow_Links_For_Files then
1335 Resolved_Path_Name := Canonical_Path_Name;
1337 else
1338 Name_Len := 0;
1339 Add_Str_To_Name_Buffer
1340 (Normalize_Pathname
1341 (Canonical_Path,
1342 Resolve_Links => True,
1343 Case_Sensitive => False));
1344 Resolved_Path_Name := Name_Find;
1345 end if;
1347 end;
1349 if Has_Circular_Dependencies
1350 (Env.Flags, Normed_Path_Name, Canonical_Path_Name)
1351 then
1352 Project := Empty_Node;
1353 return;
1354 end if;
1356 -- Put the new path name on the stack
1358 Project_Stack.Append
1359 ((Path_Name => Normed_Path_Name,
1360 Canonical_Path_Name => Canonical_Path_Name,
1361 Id => Empty_Node,
1362 Limited_With => In_Limited));
1364 -- Check if the project file has already been parsed
1366 while
1367 A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
1368 loop
1369 if A_Project_Name_And_Node.Resolved_Path = Resolved_Path_Name then
1370 if Extended then
1372 if A_Project_Name_And_Node.Extended then
1373 if A_Project_Name_And_Node.Proj_Qualifier /= Dry then
1374 Error_Msg
1375 (Env.Flags,
1376 "cannot extend the same project file several times",
1377 Token_Ptr);
1378 end if;
1379 elsif not A_Project_Name_And_Node.From_Extended then
1380 Error_Msg
1381 (Env.Flags,
1382 "cannot extend an already imported project file",
1383 Token_Ptr);
1385 else
1386 -- Register this project as being extended
1388 A_Project_Name_And_Node.Extended := True;
1389 Tree_Private_Part.Projects_Htable.Set
1390 (In_Tree.Projects_HT,
1391 A_Project_Name_And_Node.Name,
1392 A_Project_Name_And_Node);
1393 end if;
1395 elsif A_Project_Name_And_Node.Extended then
1396 Extends_All :=
1397 Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree);
1399 -- If the imported project is an extended project A, and we are
1400 -- in an extended project, replace A with the ultimate project
1401 -- extending A.
1403 if From_Extended /= None then
1404 declare
1405 Decl : Project_Node_Id :=
1406 Project_Declaration_Of
1407 (A_Project_Name_And_Node.Node, In_Tree);
1409 Prj : Project_Node_Id :=
1410 A_Project_Name_And_Node.Node;
1412 begin
1413 -- Loop through extending projects to find the ultimate
1414 -- extending project, that is the one that is not
1415 -- extended. For an abstract project, as it can be
1416 -- extended several times, there is no extending project
1417 -- registered, so the loop does not execute and the
1418 -- resulting project is the abstract project.
1420 while
1421 Extending_Project_Of (Decl, In_Tree) /= Empty_Node
1422 loop
1423 Prj := Extending_Project_Of (Decl, In_Tree);
1424 Decl := Project_Declaration_Of (Prj, In_Tree);
1425 end loop;
1427 A_Project_Name_And_Node.Node := Prj;
1428 end;
1429 else
1430 Error_Msg
1431 (Env.Flags,
1432 "cannot import an already extended project file",
1433 Token_Ptr);
1434 end if;
1436 elsif A_Project_Name_And_Node.From_Extended then
1437 -- This project is now imported from a non extending project.
1438 -- Indicate this in has table Projects.HT.
1440 A_Project_Name_And_Node.From_Extended := False;
1441 Tree_Private_Part.Projects_Htable.Set
1442 (In_Tree.Projects_HT,
1443 A_Project_Name_And_Node.Name,
1444 A_Project_Name_And_Node);
1445 end if;
1447 Project := A_Project_Name_And_Node.Node;
1448 Project_Stack.Decrement_Last;
1449 return;
1450 end if;
1452 A_Project_Name_And_Node :=
1453 Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT);
1454 end loop;
1456 -- We never encountered this project file. Save the scan state, load the
1457 -- project file and start to scan it.
1459 Save_Project_Scan_State (Project_Scan_State);
1460 Source_Index := Load_Project_File (Path_Name);
1461 Tree.Save (Project_Comment_State);
1463 -- If we cannot find it, we stop
1465 if Source_Index = No_Source_File then
1466 Project := Empty_Node;
1467 Project_Stack.Decrement_Last;
1468 return;
1469 end if;
1471 Prj.Err.Scanner.Initialize_Scanner (Source_Index);
1472 Tree.Reset_State;
1473 Scan (In_Tree);
1475 if not Is_Config_File
1476 and then Name_From_Path = No_Name
1477 and then not Implicit_Project
1478 then
1480 -- The project file name is not correct (no or bad extension, or not
1481 -- following Ada identifier's syntax).
1483 Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
1484 Error_Msg (Env.Flags,
1485 "?{ is not a valid path name for a project file",
1486 Token_Ptr);
1487 end if;
1489 if Current_Verbosity >= Medium then
1491 end if;
1493 Project_Directory :=
1494 Path_Name_Type (Get_Directory (File_Name_Type (Normed_Path_Name)));
1496 -- Is there any imported project?
1498 Pre_Parse_Context_Clause
1499 (In_Tree => In_Tree,
1500 Is_Config_File => Is_Config_File,
1501 Context_Clause => First_With,
1502 Flags => Env.Flags);
1504 Project := Default_Project_Node
1505 (Of_Kind => N_Project, In_Tree => In_Tree);
1506 Project_Stack.Table (Project_Stack.Last).Id := Project;
1507 Set_Directory_Of (Project, In_Tree, Project_Directory);
1508 Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name);
1510 Read_Project_Qualifier
1511 (Env.Flags, In_Tree, Is_Config_File, Qualifier_Location, Project);
1513 Set_Location_Of (Project, In_Tree, Token_Ptr);
1517 -- Mark location of PROJECT token if present
1519 if Token = Tok_Project then
1520 Scan (In_Tree); -- past PROJECT
1521 Set_Location_Of (Project, In_Tree, Token_Ptr);
1522 end if;
1524 -- Clear the Buffer
1526 Buffer_Last := 0;
1527 loop
1530 -- If the token is not an identifier, clear the buffer before
1531 -- exiting to indicate that the name of the project is ill-formed.
1533 if Token /= Tok_Identifier then
1534 Buffer_Last := 0;
1535 exit;
1536 end if;
1538 -- Add the identifier name to the buffer
1540 Get_Name_String (Token_Name);
1541 Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1543 -- Scan past the identifier
1545 Scan (In_Tree);
1547 -- If we have a dot, add a dot to the Buffer and look for the next
1548 -- identifier.
1550 exit when Token /= Tok_Dot;
1553 -- Scan past the dot
1555 Scan (In_Tree);
1556 end loop;
1558 -- See if this is an extending project
1560 if Token = Tok_Extends then
1562 if Is_Config_File then
1563 Error_Msg
1564 (Env.Flags,
1566 end if;
1568 -- Make sure that gnatmake will use mapping files
1570 Opt.Create_Mapping_File := True;
1572 -- We are extending another project
1574 Extending := True;
1576 Scan (In_Tree); -- past EXTENDS
1578 if Token = Tok_All then
1579 Extends_All := True;
1580 Set_Is_Extending_All (Project, In_Tree);
1581 Scan (In_Tree); -- scan past ALL
1582 end if;
1583 end if;
1585 -- If the name is well formed, Buffer_Last is > 0
1587 if Buffer_Last > 0 then
1589 -- The Buffer contains the name of the project
1591 Name_Len := Buffer_Last;
1592 Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
1593 Name_Of_Project := Name_Find;
1594 Set_Name_Of (Project, In_Tree, Name_Of_Project);
1596 -- To get expected name of the project file, replace dots by dashes
1598 for Index in 1 .. Name_Len loop
1599 if Name_Buffer (Index) = '.' then
1600 Name_Buffer (Index) := '-';
1601 end if;
1602 end loop;
1604 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1606 declare
1607 Expected_Name : constant Name_Id := Name_Find;
1608 Extension : String_Access;
1610 begin
1611 -- Output a warning if the actual name is not the expected name
1613 if not Is_Config_File
1614 and then (Name_From_Path /= No_Name)
1615 and then Expected_Name /= Name_From_Path
1616 then
1617 Error_Msg_Name_1 := Expected_Name;
1619 if Is_Config_File then
1620 Extension := new String'(Config_Project_File_Extension);
1622 else
1623 Extension := new String'(Project_File_Extension);
1624 end if;
1626 Error_Msg
1627 (Env.Flags,
1630 Token_Ptr);
1631 end if;
1632 end;
1634 -- Read the original casing of the project name
1636 declare
1637 Loc : Source_Ptr;
1639 begin
1640 Loc := Location_Of (Project, In_Tree);
1641 for J in 1 .. Name_Len loop
1642 Name_Buffer (J) := Sinput.Source (Loc);
1643 Loc := Loc + 1;
1644 end loop;
1646 Display_Name_Of_Project := Name_Find;
1647 end;
1649 declare
1650 From_Ext : Extension_Origin := None;
1652 begin
1653 -- Extending_All is always propagated
1655 if From_Extended = Extending_All or else Extends_All then
1656 From_Ext := Extending_All;
1658 -- Otherwise, From_Extended is set to Extending_Single if the
1659 -- current project is an extending project.
1661 elsif Extended then
1662 From_Ext := Extending_Simple;
1663 end if;
1665 Post_Parse_Context_Clause
1666 (In_Tree => In_Tree,
1667 Context_Clause => First_With,
1668 In_Limited => In_Limited,
1669 Limited_Withs => False,
1670 Imported_Projects => Imported_Projects,
1671 Project_Directory => Project_Directory,
1672 From_Extended => From_Ext,
1673 Packages_To_Check => Packages_To_Check,
1674 Depth => Depth + 1,
1675 Current_Dir => Current_Dir,
1676 Is_Config_File => Is_Config_File,
1677 Env => Env);
1678 Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
1679 end;
1681 if not Is_Config_File then
1682 declare
1683 Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1684 Tree_Private_Part.Projects_Htable.Get_First
1685 (In_Tree.Projects_HT);
1686 Project_Name : Name_Id := Name_And_Node.Name;
1688 begin
1689 -- Check if we already have a project with this name
1691 while Project_Name /= No_Name
1692 and then Project_Name /= Name_Of_Project
1693 loop
1694 Name_And_Node :=
1695 Tree_Private_Part.Projects_Htable.Get_Next
1696 (In_Tree.Projects_HT);
1697 Project_Name := Name_And_Node.Name;
1698 end loop;
1700 -- Report an error if we already have a project with this name
1702 if Project_Name /= No_Name then
1703 Duplicated := True;
1704 Error_Msg_Name_1 := Project_Name;
1705 Error_Msg
1707 Location_Of (Project, In_Tree));
1708 Error_Msg_Name_1 :=
1709 Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
1710 Error_Msg
1711 (Env.Flags,
1713 end if;
1714 end;
1715 end if;
1717 end if;
1719 if Extending then
1722 if Token = Tok_String_Literal then
1723 Set_Extended_Project_Path_Of
1724 (Project,
1725 In_Tree,
1726 Path_Name_Type (Token_Name));
1728 declare
1729 Original_Path_Name : constant String :=
1730 Get_Name_String (Token_Name);
1732 Extended_Project_Path_Name_Id : Path_Name_Type;
1734 begin
1735 Find_Project
1736 (Env.Project_Path,
1737 Project_File_Name => Original_Path_Name,
1738 Directory => Get_Name_String (Project_Directory),
1739 Path => Extended_Project_Path_Name_Id);
1741 if Extended_Project_Path_Name_Id = No_Path then
1743 -- We could not find the project file to extend
1745 Error_Msg_Name_1 := Token_Name;
1749 -- If not in the main project file, display the import path
1751 if Project_Stack.Last > 1 then
1752 Error_Msg_Name_1 :=
1753 Name_Id
1754 (Project_Stack.Table (Project_Stack.Last).Path_Name);
1757 for Index in reverse 1 .. Project_Stack.Last - 1 loop
1758 Error_Msg_Name_1 :=
1759 Name_Id
1760 (Project_Stack.Table (Index).Path_Name);
1762 end loop;
1763 end if;
1765 else
1766 declare
1767 From_Ext : Extension_Origin := None;
1769 begin
1770 if From_Extended = Extending_All or else Extends_All then
1771 From_Ext := Extending_All;
1772 end if;
1774 Parse_Single_Project
1775 (In_Tree => In_Tree,
1776 Project => Extended_Project,
1777 Extends_All => Extends_All,
1778 Path_Name_Id => Extended_Project_Path_Name_Id,
1779 Extended => True,
1780 From_Extended => From_Ext,
1781 In_Limited => In_Limited,
1782 Packages_To_Check => Packages_To_Check,
1783 Depth => Depth + 1,
1784 Current_Dir => Current_Dir,
1785 Is_Config_File => Is_Config_File,
1786 Env => Env);
1787 end;
1789 if Present (Extended_Project) then
1791 if Project_Qualifier_Of (Extended_Project, In_Tree) =
1792 Aggregate
1793 then
1794 Error_Msg_Name_1 :=
1795 Name_Id (Path_Name_Of (Extended_Project, In_Tree));
1796 Error_Msg
1797 (Env.Flags,
1799 Location_Of (Project, In_Tree));
1800 end if;
1802 -- A project that extends an extending-all project is
1803 -- also an extending-all project.
1805 if Is_Extending_All (Extended_Project, In_Tree) then
1806 Set_Is_Extending_All (Project, In_Tree);
1807 end if;
1809 -- An abstract project can only extend an abstract
1810 -- project. Otherwise we may have an abstract project
1811 -- with sources if it inherits sources from the project
1812 -- it extends.
1814 if Project_Qualifier_Of (Project, In_Tree) = Dry and then
1815 Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
1816 then
1817 Error_Msg
1820 Qualifier_Location);
1821 end if;
1822 end if;
1823 end if;
1824 end;
1826 Scan (In_Tree); -- past the extended project path
1827 end if;
1828 end if;
1830 Check_Extending_All_Imports (Env.Flags, In_Tree, Project);
1831 Check_Aggregate_Imports (Env.Flags, In_Tree, Project);
1832 Check_Import_Aggregate (Env.Flags, In_Tree, Project);
1834 -- Check that a project with a name including a dot either imports
1835 -- or extends the project whose name precedes the last dot.
1837 if Name_Of_Project /= No_Name then
1838 Get_Name_String (Name_Of_Project);
1840 else
1841 Name_Len := 0;
1842 end if;
1844 -- Look for the last dot
1846 while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop
1847 Name_Len := Name_Len - 1;
1848 end loop;
1850 -- If a dot was found, check if parent project is imported or extended
1852 if Name_Len > 0 then
1853 Name_Len := Name_Len - 1;
1855 declare
1856 Parent_Name : constant Name_Id := Name_Find;
1857 Parent_Found : Boolean := False;
1858 Parent_Node : Project_Node_Id := Empty_Node;
1859 With_Clause : Project_Node_Id :=
1860 First_With_Clause_Of (Project, In_Tree);
1861 Imp_Proj_Name : Name_Id;
1863 begin
1864 -- If there is an extended project, check its name
1866 if Present (Extended_Project) then
1867 Parent_Node := Extended_Project;
1868 Parent_Found :=
1869 Name_Of (Extended_Project, In_Tree) = Parent_Name;
1870 end if;
1872 -- If the parent project is not the extended project,
1873 -- check each imported project until we find the parent project.
1875 Imported_Loop :
1876 while not Parent_Found and then Present (With_Clause) loop
1877 Parent_Node := Project_Node_Of (With_Clause, In_Tree);
1878 Extension_Loop : while Present (Parent_Node) loop
1879 Imp_Proj_Name := Name_Of (Parent_Node, In_Tree);
1880 Parent_Found := Imp_Proj_Name = Parent_Name;
1881 exit Imported_Loop when Parent_Found;
1882 Parent_Node :=
1883 Extended_Project_Of
1884 (Project_Declaration_Of (Parent_Node, In_Tree),
1885 In_Tree);
1886 end loop Extension_Loop;
1888 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1889 end loop Imported_Loop;
1891 if Parent_Found then
1892 Set_Parent_Project_Of (Project, In_Tree, To => Parent_Node);
1894 else
1895 -- If the parent project was not found, report an error
1897 Error_Msg_Name_1 := Name_Of_Project;
1898 Error_Msg_Name_2 := Parent_Name;
1899 Error_Msg (Env.Flags,
1901 Location_Of (Project, In_Tree));
1902 end if;
1903 end;
1904 end if;
1907 Set_End_Of_Line (Project);
1908 Set_Previous_Line_Node (Project);
1909 Set_Next_End_Node (Project);
1911 declare
1912 Project_Declaration : Project_Node_Id := Empty_Node;
1914 begin
1917 Prj.Dect.Parse
1918 (In_Tree => In_Tree,
1919 Declarations => Project_Declaration,
1920 Current_Project => Project,
1921 Extends => Extended_Project,
1922 Packages_To_Check => Packages_To_Check,
1923 Is_Config_File => Is_Config_File,
1924 Flags => Env.Flags);
1925 Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
1927 if Present (Extended_Project)
1928 and then Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
1929 then
1930 Set_Extending_Project_Of
1931 (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,
1932 To => Project);
1933 end if;
1934 end;
1937 Remove_Next_End_Node;
1941 if Token = Tok_End then
1942 Scan (In_Tree);
1943 end if;
1945 -- Clear the Buffer
1947 Buffer_Last := 0;
1950 -- several simple names.
1952 loop
1955 -- If we don't have an identifier, clear the buffer before exiting to
1956 -- avoid checking the name.
1958 if Token /= Tok_Identifier then
1959 Buffer_Last := 0;
1960 exit;
1961 end if;
1963 -- Add the identifier to the Buffer
1964 Get_Name_String (Token_Name);
1965 Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1967 -- Scan past the identifier
1969 Scan (In_Tree);
1970 exit when Token /= Tok_Dot;
1972 Scan (In_Tree);
1973 end loop;
1975 -- If we have a valid name, check if it is the name of the project
1977 if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
1978 if To_Lower (Buffer (1 .. Buffer_Last)) /=
1979 Get_Name_String (Name_Of (Project, In_Tree))
1980 then
1981 -- Invalid name: report an error
1985 Token_Ptr);
1986 end if;
1987 end if;
1991 -- Check that there is no more text following the end of the project
1992 -- source.
1994 if Token = Tok_Semicolon then
1995 Set_Previous_End_Node (Project);
1996 Scan (In_Tree);
1998 if Token /= Tok_EOF then
1999 Error_Msg
2000 (Env.Flags,
2002 end if;
2003 end if;
2005 if not Duplicated and then Name_Of_Project /= No_Name then
2007 -- Add the name of the project to the hash table, so that we can
2008 -- check that no other subsequent project will have the same name.
2010 Tree_Private_Part.Projects_Htable.Set
2011 (T => In_Tree.Projects_HT,
2012 K => Name_Of_Project,
2013 E => (Name => Name_Of_Project,
2014 Display_Name => Display_Name_Of_Project,
2015 Node => Project,
2016 Resolved_Path => Resolved_Path_Name,
2017 Extended => Extended,
2018 From_Extended => From_Extended /= None,
2019 Proj_Qualifier => Project_Qualifier_Of (Project, In_Tree)));
2020 end if;
2022 declare
2023 From_Ext : Extension_Origin := None;
2025 begin
2026 -- Extending_All is always propagated
2028 if From_Extended = Extending_All or else Extends_All then
2029 From_Ext := Extending_All;
2031 -- Otherwise, From_Extended is set to Extending_Single if the
2032 -- current project is an extending project.
2034 elsif Extended then
2035 From_Ext := Extending_Simple;
2036 end if;
2038 Post_Parse_Context_Clause
2039 (In_Tree => In_Tree,
2040 Context_Clause => First_With,
2041 In_Limited => In_Limited,
2042 Limited_Withs => True,
2043 Imported_Projects => Imported_Projects,
2044 Project_Directory => Project_Directory,
2045 From_Extended => From_Ext,
2046 Packages_To_Check => Packages_To_Check,
2047 Depth => Depth + 1,
2048 Current_Dir => Current_Dir,
2049 Is_Config_File => Is_Config_File,
2050 Env => Env);
2051 Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
2052 end;
2054 -- Restore the scan state, in case we are not the main project
2056 Restore_Project_Scan_State (Project_Scan_State);
2058 -- And remove the project from the project stack
2060 Project_Stack.Decrement_Last;
2062 -- Indicate if there are unkept comments
2064 Tree.Set_Project_File_Includes_Unkept_Comments
2065 (Node => Project,
2066 In_Tree => In_Tree,
2067 To => Tree.There_Are_Unkept_Comments);
2069 -- And restore the comment state that was saved
2071 Tree.Restore_And_Free (Project_Comment_State);
2073 Debug_Decrease_Indent;
2075 if Project /= Empty_Node and then Implicit_Project then
2076 Name_Len := 0;
2077 Add_Str_To_Name_Buffer (Current_Dir);
2078 Add_Char_To_Name_Buffer (Dir_Sep);
2079 In_Tree.Project_Nodes.Table (Project).Directory := Name_Find;
2080 end if;
2081 end Parse_Single_Project;
2083 -----------------------
2084 -- Project_Name_From --
2085 -----------------------
2087 function Project_Name_From
2088 (Path_Name : String;
2089 Is_Config_File : Boolean) return Name_Id
2090 is
2091 Canonical : String (1 .. Path_Name'Length) := Path_Name;
2092 First : Natural := Canonical'Last;
2093 Last : Natural := First;
2094 Index : Positive;
2096 begin
2097 if Current_Verbosity = High then
2099 end if;
2101 -- If the path name is empty, return No_Name to indicate failure
2103 if First = 0 then
2104 return No_Name;
2105 end if;
2107 Canonical_Case_File_Name (Canonical);
2109 -- Look for the last dot in the path name
2111 while First > 0
2112 and then
2113 Canonical (First) /= '.'
2114 loop
2115 First := First - 1;
2116 end loop;
2118 -- If we have a dot, check that it is followed by the correct extension
2120 if First > 0 and then Canonical (First) = '.' then
2121 if (not Is_Config_File
2122 and then Canonical (First .. Last) = Project_File_Extension
2123 and then First /= 1)
2124 or else
2125 (Is_Config_File
2126 and then
2127 Canonical (First .. Last) = Config_Project_File_Extension
2128 and then First /= 1)
2129 then
2130 -- Look for the last directory separator, if any
2132 First := First - 1;
2133 Last := First;
2134 while First > 0
2135 and then Canonical (First) /= '/'
2136 and then Canonical (First) /= Dir_Sep
2137 loop
2138 First := First - 1;
2139 end loop;
2141 else
2142 -- Not the correct extension, return No_Name to indicate failure
2144 return No_Name;
2145 end if;
2147 -- If no dot in the path name, return No_Name to indicate failure
2149 else
2150 return No_Name;
2151 end if;
2153 First := First + 1;
2155 -- If the extension is the file name, return No_Name to indicate failure
2157 if First > Last then
2158 return No_Name;
2159 end if;
2161 -- Put the name in lower case into Name_Buffer
2163 Name_Len := Last - First + 1;
2164 Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
2166 Index := 1;
2168 -- Check if it is a well formed project name. Return No_Name if it is
2169 -- ill formed.
2171 loop
2172 if not Is_Letter (Name_Buffer (Index)) then
2173 return No_Name;
2175 else
2176 loop
2177 Index := Index + 1;
2179 exit when Index >= Name_Len;
2181 if Name_Buffer (Index) = '_' then
2182 if Name_Buffer (Index + 1) = '_' then
2183 return No_Name;
2184 end if;
2185 end if;
2187 exit when Name_Buffer (Index) = '-';
2189 if Name_Buffer (Index) /= '_'
2190 and then not Is_Alphanumeric (Name_Buffer (Index))
2191 then
2192 return No_Name;
2193 end if;
2195 end loop;
2196 end if;
2198 if Index >= Name_Len then
2199 if Is_Alphanumeric (Name_Buffer (Name_Len)) then
2201 -- All checks have succeeded. Return name in Name_Buffer
2203 return Name_Find;
2205 else
2206 return No_Name;
2207 end if;
2209 elsif Name_Buffer (Index) = '-' then
2210 Index := Index + 1;
2211 end if;
2212 end loop;
2213 end Project_Name_From;
2215 end Prj.Part;