| blob | 234ccdc172f5540c5bdfcdb0bce12598a7ba8f61 |
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-2014, 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
353 loop
358 Virtual_Name;
362 -- Get the virtual name id
368 Virtual_Project := Create_Project
376 -- Add a WITH clause to the main project to import the newly created
377 -- virtual extending project.
382 Set_Next_With_Clause_Of
386 -- Copy with clauses for projects imported by the extending-all project
388 declare
392 begin
394 New_With_Clause :=
403 -- Virtual project node
405 Set_Location_Of
407 Set_Extended_Project_Path_Of
410 -- Project declaration
412 Set_First_Declarative_Item_Of
416 -- Source_Dirs declaration
418 Set_Current_Item_Node
421 -- Source_Dirs attribute
424 Set_Expression_Of
427 -- Source_Dirs expression
431 -- Source_Dirs term
435 -- Source_Dirs empty list: nothing to do
438 -----------------------------------
439 -- Look_For_Virtual_Projects_For --
440 -----------------------------------
443 -- Head of the current EXTENDS ALL imports list. When creating virtual
444 -- projects for an EXTENDS ALL, we import in each virtual project all
445 -- of the projects that appear in WITH clauses of the extending projects.
446 -- This ensures that virtual projects share a consistent environment (in
447 -- particular if a project imported by one of the extending projects
448 -- replaces some runtime units).
450 procedure Look_For_Virtual_Projects_For
454 is
456 -- Node for the project declaration of Proj
459 -- Node for a with clause of Proj
462 -- Node for a project imported by Proj
465 -- Node for the eventual project extended by Proj
468 -- Set True if Proj is an EXTENDS ALL project
472 begin
473 -- Nothing to do if Proj is undefined or has already been processed
477 -- Make sure the project will not be processed again
488 -- If this is a project that may need a virtual extending project
489 -- and it is not itself an extending project, put it in the list.
495 -- Now check the projects it imports
502 Look_For_Virtual_Projects_For
508 -- This is an EXTENDS ALL project: prepend each of its WITH
509 -- clauses to the currently active list of extension deps.
511 Extension_Withs :=
518 -- Check also the eventual project extended by Proj. As this project
519 -- is already extended, call recursively with Potentially_Virtual
520 -- being False.
522 Look_For_Virtual_Projects_For
529 -----------
530 -- Parse --
531 -----------
533 procedure Parse
545 is
550 Osint.To_Canonical_File_Spec
554 begin
566 end if;
568 Project := Empty_Node;
570 Find_Project (Env.Project_Path,
571 Project_File_Name => Real_Project_File_Name.all,
572 Directory => Current_Directory,
573 Path => Path_Name_Id);
574 Free (Real_Project_File_Name);
576 if Errout_Handling /= Never_Finalize then
577 Prj.Err.Initialize;
578 end if;
580 Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
581 Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
583 if Path_Name_Id = No_Path then
584 declare
585 P : String_Access;
586 begin
587 Get_Path (Env.Project_Path, Path => P);
589 Prj.Com.Fail
590 ("project file """
591 & Project_File_Name
592 & """ not found in "
593 & P.all);
594 Project := Empty_Node;
595 return;
596 end;
597 end if;
599 -- Parse the main project file
601 begin
602 Parse_Single_Project
603 (In_Tree => In_Tree,
604 Project => Project,
605 Extends_All => Dummy,
606 Path_Name_Id => Path_Name_Id,
607 Extended => False,
608 From_Extended => None,
609 In_Limited => False,
610 Packages_To_Check => Packages_To_Check,
611 Depth => 0,
612 Current_Dir => Current_Directory,
613 Is_Config_File => Is_Config_File,
614 Env => Env,
615 Implicit_Project => Implicit_Project);
617 exception
618 when Types.Unrecoverable_Error =>
620 -- Unrecoverable_Error is raised when a line is too long.
621 -- A meaningful error message will be displayed later.
623 Project := Empty_Node;
624 end;
626 -- If Project is an extending-all project, create the eventual
627 -- virtual extending projects and check that there are no illegally
628 -- imported projects.
630 if Present (Project)
631 and then Is_Extending_All (Project, In_Tree)
632 then
633 -- First look for projects that potentially need a virtual
634 -- extending project.
636 Virtual_Hash.Reset;
637 Processed_Hash.Reset;
639 -- Mark the extending all project as processed, to avoid checking
640 -- the imported projects in case of a "limited with" on this
641 -- extending all project.
643 Processed_Hash.Set (Project, True);
645 declare
646 Declaration : constant Project_Node_Id :=
647 Project_Declaration_Of (Project, In_Tree);
648 begin
649 Extension_Withs := First_With_Clause_Of (Project, In_Tree);
650 Look_For_Virtual_Projects_For
651 (Extended_Project_Of (Declaration, In_Tree), In_Tree,
652 Potentially_Virtual => False);
653 end;
655 -- Now, check the projects directly imported by the main project.
656 -- Remove from the potentially virtual any project extended by one
657 -- of these imported projects.
659 declare
660 With_Clause : Project_Node_Id;
661 Imported : Project_Node_Id := Empty_Node;
662 Declaration : Project_Node_Id := Empty_Node;
664 begin
665 With_Clause := First_With_Clause_Of (Project, In_Tree);
666 while Present (With_Clause) loop
667 Imported := Project_Node_Of (With_Clause, In_Tree);
669 if Present (Imported) then
670 Declaration := Project_Declaration_Of (Imported, In_Tree);
672 if Extended_Project_Of (Declaration, In_Tree) /=
673 Empty_Node
674 then
675 loop
676 Imported :=
677 Extended_Project_Of (Declaration, In_Tree);
678 exit when No (Imported);
679 Virtual_Hash.Remove (Imported);
680 Declaration :=
681 Project_Declaration_Of (Imported, In_Tree);
682 end loop;
683 end if;
684 end if;
686 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
687 end loop;
688 end;
690 -- Now create all the virtual extending projects
692 declare
693 Proj : Project_Node_Id := Empty_Node;
694 Withs : Project_Node_Id;
695 begin
696 Virtual_Hash.Get_First (Proj, Withs);
697 while Withs /= Project_Node_High_Bound loop
698 Create_Virtual_Extending_Project
699 (Proj, Project, Withs, In_Tree);
700 Virtual_Hash.Get_Next (Proj, Withs);
701 end loop;
702 end;
703 end if;
705 -- If there were any kind of error during the parsing, serious
706 -- or not, then the parsing fails.
708 if Total_Errors_Detected > 0 then
709 Project := Empty_Node;
710 end if;
712 case Errout_Handling is
713 when Always_Finalize =>
714 Prj.Err.Finalize;
716 -- Reinitialize to avoid duplicate warnings later on
717 Prj.Err.Initialize;
719 when Finalize_If_Error =>
720 if No (Project) then
721 Prj.Err.Finalize;
722 Prj.Err.Initialize;
723 end if;
725 when Never_Finalize =>
726 null;
727 end case;
729 exception
730 when X : others =>
732 -- Internal error
734 Write_Line (Exception_Information (X));
735 Write_Str ("Exception ");
736 Write_Str (Exception_Name (X));
737 Write_Line (" raised, while processing project file");
738 Project := Empty_Node;
739 end Parse;
741 ------------------------------
742 -- Pre_Parse_Context_Clause --
743 ------------------------------
745 procedure Pre_Parse_Context_Clause
746 (In_Tree : Project_Node_Tree_Ref;
747 Context_Clause : out With_Id;
748 Is_Config_File : Boolean;
749 Flags : Processing_Flags)
750 is
751 Current_With_Clause : With_Id := No_With;
752 Limited_With : Boolean := False;
753 Current_With : With_Record;
754 Current_With_Node : Project_Node_Id := Empty_Node;
756 begin
757 -- Assume no context clause
759 Context_Clause := No_With;
760 With_Loop :
762 -- If Token is not WITH or LIMITED, there is no context clause, or we
763 -- have exhausted the with clauses.
765 while Token = Tok_With or else Token = Tok_Limited loop
766 Current_With_Node :=
767 Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree);
768 Limited_With := Token = Tok_Limited;
770 if Is_Config_File then
771 Error_Msg
772 (Flags,
773 "configuration project cannot import " &
774 "other configuration projects",
775 Token_Ptr);
776 end if;
778 if Limited_With then
779 Scan (In_Tree); -- past LIMITED
780 Expect (Tok_With, "WITH");
781 exit With_Loop when Token /= Tok_With;
782 end if;
784 Comma_Loop :
785 loop
786 Scan (In_Tree); -- past WITH or ","
788 Expect (Tok_String_Literal, "literal string");
790 if Token /= Tok_String_Literal then
791 return;
792 end if;
794 -- Store path and location in table Withs
796 Current_With :=
797 (Path => Path_Name_Type (Token_Name),
798 Location => Token_Ptr,
799 Limited_With => Limited_With,
800 Node => Current_With_Node,
801 Next => No_With);
803 Withs.Increment_Last;
804 Withs.Table (Withs.Last) := Current_With;
806 if Current_With_Clause = No_With then
807 Context_Clause := Withs.Last;
809 else
810 Withs.Table (Current_With_Clause).Next := Withs.Last;
811 end if;
813 Current_With_Clause := Withs.Last;
815 Scan (In_Tree);
817 if Token = Tok_Semicolon then
818 Set_End_Of_Line (Current_With_Node);
819 Set_Previous_Line_Node (Current_With_Node);
821 -- End of (possibly multiple) with clause;
823 Scan (In_Tree); -- past semicolon
824 exit Comma_Loop;
826 elsif Token = Tok_Comma then
827 Set_Is_Not_Last_In_List (Current_With_Node, In_Tree);
829 else
830 Error_Msg (Flags, "expected comma or semi colon", Token_Ptr);
831 exit Comma_Loop;
832 end if;
834 Current_With_Node :=
835 Default_Project_Node
836 (Of_Kind => N_With_Clause, In_Tree => In_Tree);
837 end loop Comma_Loop;
838 end loop With_Loop;
839 end Pre_Parse_Context_Clause;
841 -------------------------------
842 -- Post_Parse_Context_Clause --
843 -------------------------------
845 procedure Post_Parse_Context_Clause
846 (Context_Clause : With_Id;
847 In_Tree : Project_Node_Tree_Ref;
848 In_Limited : Boolean;
849 Limited_Withs : Boolean;
850 Imported_Projects : in out Project_Node_Id;
851 Project_Directory : Path_Name_Type;
852 From_Extended : Extension_Origin;
853 Packages_To_Check : String_List_Access;
854 Depth : Natural;
855 Current_Dir : String;
856 Is_Config_File : Boolean;
857 Env : in out Environment)
858 is
859 Current_With_Clause : With_Id := Context_Clause;
861 Current_Project : Project_Node_Id := Imported_Projects;
862 Previous_Project : Project_Node_Id := Empty_Node;
863 Next_Project : Project_Node_Id := Empty_Node;
865 Project_Directory_Path : constant String :=
866 Get_Name_String (Project_Directory);
868 Current_With : With_Record;
869 Extends_All : Boolean := False;
870 Imported_Path_Name_Id : Path_Name_Type;
872 begin
873 -- Set Current_Project to the last project in the current list, if the
874 -- list is not empty.
876 if Present (Current_Project) then
877 while
878 Present (Next_With_Clause_Of (Current_Project, In_Tree))
879 loop
880 Current_Project := Next_With_Clause_Of (Current_Project, In_Tree);
881 end loop;
882 end if;
884 while Current_With_Clause /= No_With loop
885 Current_With := Withs.Table (Current_With_Clause);
886 Current_With_Clause := Current_With.Next;
888 if Limited_Withs = Current_With.Limited_With then
889 Find_Project
890 (Env.Project_Path,
891 Project_File_Name => Get_Name_String (Current_With.Path),
892 Directory => Project_Directory_Path,
893 Path => Imported_Path_Name_Id);
895 if Imported_Path_Name_Id = No_Path then
896 if Env.Flags.Ignore_Missing_With then
897 In_Tree.Incomplete_With := True;
899 else
900 -- The project file cannot be found
902 Error_Msg_File_1 := File_Name_Type (Current_With.Path);
903 Error_Msg
904 (Env.Flags, "unknown project file: {",
905 Current_With.Location);
907 -- If this is not imported by the main project file, display
908 -- the import path.
910 if Project_Stack.Last > 1 then
911 for Index in reverse 1 .. Project_Stack.Last loop
912 Error_Msg_File_1 :=
913 File_Name_Type
914 (Project_Stack.Table (Index).Path_Name);
915 Error_Msg
917 end loop;
918 end if;
919 end if;
921 else
922 -- New with clause
924 declare
925 Resolved_Path : constant String :=
926 Normalize_Pathname
927 (Get_Name_String (Imported_Path_Name_Id),
928 Directory => Current_Dir,
929 Resolve_Links =>
930 Opt.Follow_Links_For_Files,
931 Case_Sensitive => True);
933 Withed_Project : Project_Node_Id := Empty_Node;
935 begin
936 Previous_Project := Current_Project;
938 if No (Current_Project) then
940 -- First with clause of the context clause
942 Current_Project := Current_With.Node;
943 Imported_Projects := Current_Project;
945 else
946 Next_Project := Current_With.Node;
947 Set_Next_With_Clause_Of
948 (Current_Project, In_Tree, Next_Project);
949 Current_Project := Next_Project;
950 end if;
952 Set_String_Value_Of
953 (Current_Project,
954 In_Tree,
955 Name_Id (Current_With.Path));
956 Set_Location_Of
957 (Current_Project, In_Tree, Current_With.Location);
959 -- If it is a limited with, check if we have a circularity.
960 -- If we have one, get the project id of the limited
961 -- imported project file, and do not parse it.
963 if (In_Limited or Limited_Withs)
964 and then Project_Stack.Last > 1
965 then
966 declare
967 Canonical_Path_Name : Path_Name_Type;
969 begin
970 Name_Len := Resolved_Path'Length;
971 Name_Buffer (1 .. Name_Len) := Resolved_Path;
972 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
973 Canonical_Path_Name := Name_Find;
975 for Index in 1 .. Project_Stack.Last loop
976 if Project_Stack.Table (Index).Canonical_Path_Name =
977 Canonical_Path_Name
978 then
979 -- We have found the limited imported project,
980 -- get its project id, and do not parse it.
982 Withed_Project := Project_Stack.Table (Index).Id;
983 exit;
984 end if;
985 end loop;
986 end;
987 end if;
989 -- Parse the imported project if its project id is unknown
991 if No (Withed_Project) then
992 Parse_Single_Project
993 (In_Tree => In_Tree,
994 Project => Withed_Project,
995 Extends_All => Extends_All,
996 Path_Name_Id => Imported_Path_Name_Id,
997 Extended => False,
998 From_Extended => From_Extended,
999 In_Limited => In_Limited or Limited_Withs,
1000 Packages_To_Check => Packages_To_Check,
1001 Depth => Depth,
1002 Current_Dir => Current_Dir,
1003 Is_Config_File => Is_Config_File,
1004 Env => Env);
1006 else
1007 Extends_All := Is_Extending_All (Withed_Project, In_Tree);
1008 end if;
1010 if No (Withed_Project) then
1012 -- If parsing unsuccessful, remove the context clause
1014 Current_Project := Previous_Project;
1016 if No (Current_Project) then
1017 Imported_Projects := Empty_Node;
1019 else
1020 Set_Next_With_Clause_Of
1021 (Current_Project, In_Tree, Empty_Node);
1022 end if;
1023 else
1024 -- If parsing was successful, record project name and
1025 -- path name in with clause
1027 Set_Project_Node_Of
1028 (Node => Current_Project,
1029 In_Tree => In_Tree,
1030 To => Withed_Project,
1031 Limited_With => Current_With.Limited_With);
1032 Set_Name_Of
1033 (Current_Project,
1034 In_Tree,
1035 Name_Of (Withed_Project, In_Tree));
1037 Name_Len := Resolved_Path'Length;
1038 Name_Buffer (1 .. Name_Len) := Resolved_Path;
1039 Set_Path_Name_Of (Current_Project, In_Tree, Name_Find);
1041 if Extends_All then
1042 Set_Is_Extending_All (Current_Project, In_Tree);
1043 end if;
1044 end if;
1045 end;
1046 end if;
1047 end if;
1048 end loop;
1049 end Post_Parse_Context_Clause;
1051 ---------------------------------
1052 -- Check_Extending_All_Imports --
1053 ---------------------------------
1055 procedure Check_Extending_All_Imports
1056 (Flags : Processing_Flags;
1057 In_Tree : Project_Node_Tree_Ref;
1058 Project : Project_Node_Id)
1059 is
1060 With_Clause : Project_Node_Id;
1061 Imported : Project_Node_Id;
1063 begin
1064 if not Is_Extending_All (Project, In_Tree) then
1065 With_Clause := First_With_Clause_Of (Project, In_Tree);
1066 while Present (With_Clause) loop
1067 Imported := Project_Node_Of (With_Clause, In_Tree);
1069 if Is_Extending_All (With_Clause, In_Tree) then
1070 Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
1071 Error_Msg (Flags, "cannot import extending-all project %%",
1072 Token_Ptr);
1073 exit;
1074 end if;
1076 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1077 end loop;
1078 end if;
1079 end Check_Extending_All_Imports;
1081 -----------------------------
1082 -- Check_Aggregate_Imports --
1083 -----------------------------
1085 procedure Check_Aggregate_Imports
1086 (Flags : Processing_Flags;
1087 In_Tree : Project_Node_Tree_Ref;
1088 Project : Project_Node_Id)
1089 is
1090 With_Clause, Imported : Project_Node_Id;
1091 begin
1092 if Project_Qualifier_Of (Project, In_Tree) = Aggregate then
1093 With_Clause := First_With_Clause_Of (Project, In_Tree);
1095 while Present (With_Clause) loop
1096 Imported := Project_Node_Of (With_Clause, In_Tree);
1098 if Project_Qualifier_Of (Imported, In_Tree) /= Abstract_Project
1099 then
1100 Error_Msg_Name_1 := Name_Id (Path_Name_Of (Imported, In_Tree));
1101 Error_Msg (Flags, "can only import abstract projects, not %%",
1102 Token_Ptr);
1103 exit;
1104 end if;
1106 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1107 end loop;
1108 end if;
1109 end Check_Aggregate_Imports;
1111 ----------------------------
1112 -- Check_Import_Aggregate --
1113 ----------------------------
1115 procedure Check_Import_Aggregate
1116 (Flags : Processing_Flags;
1117 In_Tree : Project_Node_Tree_Ref;
1118 Project : Project_Node_Id)
1119 is
1120 With_Clause : Project_Node_Id;
1121 Imported : Project_Node_Id;
1123 begin
1124 if Project_Qualifier_Of (Project, In_Tree) /= Aggregate then
1125 With_Clause := First_With_Clause_Of (Project, In_Tree);
1126 while Present (With_Clause) loop
1127 Imported := Project_Node_Of (With_Clause, In_Tree);
1129 if Project_Qualifier_Of (Imported, In_Tree) = Aggregate then
1130 Error_Msg_Name_1 := Name_Id (Path_Name_Of (Imported, In_Tree));
1131 Error_Msg
1132 (Flags, "cannot import aggregate project %%", Token_Ptr);
1133 exit;
1134 end if;
1136 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1137 end loop;
1138 end if;
1139 end Check_Import_Aggregate;
1141 ----------------------------
1142 -- Read_Project_Qualifier --
1143 ----------------------------
1145 procedure Read_Project_Qualifier
1146 (Flags : Processing_Flags;
1147 In_Tree : Project_Node_Tree_Ref;
1148 Is_Config_File : Boolean;
1149 Qualifier_Location : out Source_Ptr;
1150 Project : Project_Node_Id)
1151 is
1152 Proj_Qualifier : Project_Qualifier := Unspecified;
1153 begin
1154 Qualifier_Location := Token_Ptr;
1156 if Token = Tok_Abstract then
1157 Proj_Qualifier := Abstract_Project;
1158 Scan (In_Tree);
1160 elsif Token = Tok_Identifier then
1161 case Token_Name is
1162 when Snames.Name_Standard =>
1163 Proj_Qualifier := Standard;
1164 Scan (In_Tree);
1166 when Snames.Name_Aggregate =>
1167 Proj_Qualifier := Aggregate;
1168 Scan (In_Tree);
1170 if Token = Tok_Identifier
1171 and then Token_Name = Snames.Name_Library
1172 then
1173 Proj_Qualifier := Aggregate_Library;
1174 Scan (In_Tree);
1175 end if;
1177 when Snames.Name_Library =>
1178 Proj_Qualifier := Library;
1179 Scan (In_Tree);
1181 when Snames.Name_Configuration =>
1182 if not Is_Config_File then
1183 Error_Msg
1184 (Flags,
1185 "configuration projects cannot belong to a user" &
1186 " project tree",
1187 Token_Ptr);
1188 end if;
1190 Proj_Qualifier := Configuration;
1191 Scan (In_Tree);
1193 when others =>
1194 null;
1195 end case;
1196 end if;
1198 if Is_Config_File and then Proj_Qualifier = Unspecified then
1200 -- Set the qualifier to Configuration, even if the token doesn't
1201 -- exist in the source file itself, so that we can differentiate
1202 -- project files and configuration files later on.
1204 Proj_Qualifier := Configuration;
1205 end if;
1207 if Proj_Qualifier /= Unspecified then
1208 if Is_Config_File
1209 and then Proj_Qualifier /= Configuration
1210 then
1211 Error_Msg (Flags,
1212 "a configuration project cannot be qualified except " &
1213 "as configuration project",
1214 Qualifier_Location);
1215 end if;
1217 Set_Project_Qualifier_Of (Project, In_Tree, Proj_Qualifier);
1218 end if;
1219 end Read_Project_Qualifier;
1221 -------------------------------
1222 -- Has_Circular_Dependencies --
1223 -------------------------------
1225 function Has_Circular_Dependencies
1226 (Flags : Processing_Flags;
1227 Normed_Path_Name : Path_Name_Type;
1228 Canonical_Path_Name : Path_Name_Type) return Boolean is
1229 begin
1230 for Index in reverse 1 .. Project_Stack.Last loop
1231 exit when Project_Stack.Table (Index).Limited_With;
1233 if Canonical_Path_Name =
1234 Project_Stack.Table (Index).Canonical_Path_Name
1235 then
1236 Error_Msg (Flags, "circular dependency detected", Token_Ptr);
1237 Error_Msg_Name_1 := Name_Id (Normed_Path_Name);
1240 for Current in reverse 1 .. Project_Stack.Last loop
1241 Error_Msg_Name_1 :=
1242 Name_Id (Project_Stack.Table (Current).Path_Name);
1244 if Project_Stack.Table (Current).Canonical_Path_Name /=
1245 Canonical_Path_Name
1246 then
1247 Error_Msg
1250 else
1252 exit;
1253 end if;
1254 end loop;
1256 return True;
1257 end if;
1258 end loop;
1259 return False;
1260 end Has_Circular_Dependencies;
1262 --------------------------
1263 -- Parse_Single_Project --
1264 --------------------------
1266 procedure Parse_Single_Project
1267 (In_Tree : Project_Node_Tree_Ref;
1268 Project : out Project_Node_Id;
1269 Extends_All : out Boolean;
1270 Path_Name_Id : Path_Name_Type;
1271 Extended : Boolean;
1272 From_Extended : Extension_Origin;
1273 In_Limited : Boolean;
1274 Packages_To_Check : String_List_Access;
1275 Depth : Natural;
1276 Current_Dir : String;
1277 Is_Config_File : Boolean;
1278 Env : in out Environment;
1279 Implicit_Project : Boolean := False)
1280 is
1281 Path_Name : constant String := Get_Name_String (Path_Name_Id);
1283 Normed_Path_Name : Path_Name_Type;
1284 Canonical_Path_Name : Path_Name_Type;
1285 Resolved_Path_Name : Path_Name_Type;
1286 Project_Directory : Path_Name_Type;
1287 Project_Scan_State : Saved_Project_Scan_State;
1288 Source_Index : Source_File_Index;
1290 Extending : Boolean := False;
1292 Extended_Project : Project_Node_Id := Empty_Node;
1294 A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1295 Tree_Private_Part.Projects_Htable.Get_First
1296 (In_Tree.Projects_HT);
1298 Name_From_Path : constant Name_Id :=
1299 Project_Name_From (Path_Name, Is_Config_File => Is_Config_File);
1300 Name_Of_Project : Name_Id := No_Name;
1302 Duplicated : Boolean := False;
1304 First_With : With_Id;
1305 Imported_Projects : Project_Node_Id := Empty_Node;
1307 use Tree_Private_Part;
1309 Project_Comment_State : Tree.Comment_State;
1311 Qualifier_Location : Source_Ptr;
1313 begin
1314 Extends_All := False;
1316 declare
1317 Normed_Path : constant String := Normalize_Pathname
1318 (Path_Name,
1319 Directory => Current_Dir,
1320 Resolve_Links => False,
1321 Case_Sensitive => True);
1322 Canonical_Path : constant String := Normalize_Pathname
1323 (Normed_Path,
1324 Directory => Current_Dir,
1325 Resolve_Links => Opt.Follow_Links_For_Files,
1326 Case_Sensitive => False);
1327 begin
1328 Name_Len := Normed_Path'Length;
1329 Name_Buffer (1 .. Name_Len) := Normed_Path;
1330 Normed_Path_Name := Name_Find;
1331 Name_Len := Canonical_Path'Length;
1332 Name_Buffer (1 .. Name_Len) := Canonical_Path;
1333 Canonical_Path_Name := Name_Find;
1335 if Opt.Follow_Links_For_Files then
1336 Resolved_Path_Name := Canonical_Path_Name;
1338 else
1339 Name_Len := 0;
1340 Add_Str_To_Name_Buffer
1341 (Normalize_Pathname
1342 (Canonical_Path,
1343 Resolve_Links => True,
1344 Case_Sensitive => False));
1345 Resolved_Path_Name := Name_Find;
1346 end if;
1348 end;
1350 if Has_Circular_Dependencies
1351 (Env.Flags, Normed_Path_Name, Canonical_Path_Name)
1352 then
1353 Project := Empty_Node;
1354 return;
1355 end if;
1357 -- Put the new path name on the stack
1359 Project_Stack.Append
1360 ((Path_Name => Normed_Path_Name,
1361 Canonical_Path_Name => Canonical_Path_Name,
1362 Id => Empty_Node,
1363 Limited_With => In_Limited));
1365 -- Check if the project file has already been parsed
1367 while
1368 A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
1369 loop
1370 if A_Project_Name_And_Node.Resolved_Path = Resolved_Path_Name then
1371 if Extended then
1373 if A_Project_Name_And_Node.Extended then
1374 if A_Project_Name_And_Node.Proj_Qualifier /= Abstract_Project
1375 then
1376 Error_Msg
1377 (Env.Flags,
1378 "cannot extend the same project file several times",
1379 Token_Ptr);
1380 end if;
1381 elsif not A_Project_Name_And_Node.From_Extended then
1382 Error_Msg
1383 (Env.Flags,
1384 "cannot extend an already imported project file",
1385 Token_Ptr);
1387 else
1388 -- Register this project as being extended
1390 A_Project_Name_And_Node.Extended := True;
1391 Tree_Private_Part.Projects_Htable.Set
1392 (In_Tree.Projects_HT,
1393 A_Project_Name_And_Node.Name,
1394 A_Project_Name_And_Node);
1395 end if;
1397 elsif A_Project_Name_And_Node.Extended then
1398 Extends_All :=
1399 Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree);
1401 -- If the imported project is an extended project A, and we are
1402 -- in an extended project, replace A with the ultimate project
1403 -- extending A.
1405 if From_Extended /= None then
1406 declare
1407 Decl : Project_Node_Id :=
1408 Project_Declaration_Of
1409 (A_Project_Name_And_Node.Node, In_Tree);
1411 Prj : Project_Node_Id :=
1412 A_Project_Name_And_Node.Node;
1414 begin
1415 -- Loop through extending projects to find the ultimate
1416 -- extending project, that is the one that is not
1417 -- extended. For an abstract project, as it can be
1418 -- extended several times, there is no extending project
1419 -- registered, so the loop does not execute and the
1420 -- resulting project is the abstract project.
1422 while
1423 Extending_Project_Of (Decl, In_Tree) /= Empty_Node
1424 loop
1425 Prj := Extending_Project_Of (Decl, In_Tree);
1426 Decl := Project_Declaration_Of (Prj, In_Tree);
1427 end loop;
1429 A_Project_Name_And_Node.Node := Prj;
1430 end;
1431 else
1432 Error_Msg
1433 (Env.Flags,
1434 "cannot import an already extended project file",
1435 Token_Ptr);
1436 end if;
1438 elsif A_Project_Name_And_Node.From_Extended then
1439 -- This project is now imported from a non extending project.
1440 -- Indicate this in has table Projects.HT.
1442 A_Project_Name_And_Node.From_Extended := False;
1443 Tree_Private_Part.Projects_Htable.Set
1444 (In_Tree.Projects_HT,
1445 A_Project_Name_And_Node.Name,
1446 A_Project_Name_And_Node);
1447 end if;
1449 Project := A_Project_Name_And_Node.Node;
1450 Project_Stack.Decrement_Last;
1451 return;
1452 end if;
1454 A_Project_Name_And_Node :=
1455 Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT);
1456 end loop;
1458 -- We never encountered this project file. Save the scan state, load the
1459 -- project file and start to scan it.
1461 Save_Project_Scan_State (Project_Scan_State);
1462 Source_Index := Load_Project_File (Path_Name);
1463 Tree.Save (Project_Comment_State);
1465 -- If we cannot find it, we stop
1467 if Source_Index = No_Source_File then
1468 Project := Empty_Node;
1469 Project_Stack.Decrement_Last;
1470 return;
1471 end if;
1473 Prj.Err.Scanner.Initialize_Scanner (Source_Index);
1474 Tree.Reset_State;
1475 Scan (In_Tree);
1477 if not Is_Config_File
1478 and then Name_From_Path = No_Name
1479 and then not Implicit_Project
1480 then
1482 -- The project file name is not correct (no or bad extension, or not
1483 -- following Ada identifier's syntax).
1485 Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
1486 Error_Msg (Env.Flags,
1487 "?{ is not a valid path name for a project file",
1488 Token_Ptr);
1489 end if;
1491 if Current_Verbosity >= Medium then
1493 end if;
1495 Project_Directory :=
1496 Path_Name_Type (Get_Directory (File_Name_Type (Normed_Path_Name)));
1498 -- Is there any imported project?
1500 Pre_Parse_Context_Clause
1501 (In_Tree => In_Tree,
1502 Is_Config_File => Is_Config_File,
1503 Context_Clause => First_With,
1504 Flags => Env.Flags);
1506 Project := Default_Project_Node
1507 (Of_Kind => N_Project, In_Tree => In_Tree);
1508 Project_Stack.Table (Project_Stack.Last).Id := Project;
1509 Set_Directory_Of (Project, In_Tree, Project_Directory);
1510 Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name);
1512 Read_Project_Qualifier
1513 (Env.Flags, In_Tree, Is_Config_File, Qualifier_Location, Project);
1515 Set_Location_Of (Project, In_Tree, Token_Ptr);
1519 -- Mark location of PROJECT token if present
1521 if Token = Tok_Project then
1522 Scan (In_Tree); -- past PROJECT
1523 Set_Location_Of (Project, In_Tree, Token_Ptr);
1524 end if;
1526 -- Clear the Buffer
1528 Buffer_Last := 0;
1529 loop
1532 -- If the token is not an identifier, clear the buffer before
1533 -- exiting to indicate that the name of the project is ill-formed.
1535 if Token /= Tok_Identifier then
1536 Buffer_Last := 0;
1537 exit;
1538 end if;
1540 -- Add the identifier name to the buffer
1542 Get_Name_String (Token_Name);
1543 Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1545 -- Scan past the identifier
1547 Scan (In_Tree);
1549 -- If we have a dot, add a dot to the Buffer and look for the next
1550 -- identifier.
1552 exit when Token /= Tok_Dot;
1555 -- Scan past the dot
1557 Scan (In_Tree);
1558 end loop;
1560 -- See if this is an extending project
1562 if Token = Tok_Extends then
1564 if Is_Config_File then
1565 Error_Msg
1566 (Env.Flags,
1568 end if;
1570 -- Make sure that gnatmake will use mapping files
1572 Opt.Create_Mapping_File := True;
1574 -- We are extending another project
1576 Extending := True;
1578 Scan (In_Tree); -- past EXTENDS
1580 if Token = Tok_All then
1581 Extends_All := True;
1582 Set_Is_Extending_All (Project, In_Tree);
1583 Scan (In_Tree); -- scan past ALL
1584 end if;
1585 end if;
1587 -- If the name is well formed, Buffer_Last is > 0
1589 if Buffer_Last > 0 then
1591 -- The Buffer contains the name of the project
1593 Name_Len := Buffer_Last;
1594 Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
1595 Name_Of_Project := Name_Find;
1596 Set_Name_Of (Project, In_Tree, Name_Of_Project);
1598 -- To get expected name of the project file, replace dots by dashes
1600 for Index in 1 .. Name_Len loop
1601 if Name_Buffer (Index) = '.' then
1602 Name_Buffer (Index) := '-';
1603 end if;
1604 end loop;
1606 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1608 declare
1609 Expected_Name : constant Name_Id := Name_Find;
1610 Extension : String_Access;
1612 begin
1613 -- Output a warning if the actual name is not the expected name
1615 if not Is_Config_File
1616 and then (Name_From_Path /= No_Name)
1617 and then Expected_Name /= Name_From_Path
1618 then
1619 Error_Msg_Name_1 := Expected_Name;
1621 if Is_Config_File then
1622 Extension := new String'(Config_Project_File_Extension);
1624 else
1625 Extension := new String'(Project_File_Extension);
1626 end if;
1628 Error_Msg
1629 (Env.Flags,
1632 Token_Ptr);
1633 end if;
1634 end;
1636 -- Read the original casing of the project name and put it in the
1637 -- project node.
1639 declare
1640 Loc : Source_Ptr;
1641 begin
1642 Loc := Location_Of (Project, In_Tree);
1643 for J in 1 .. Name_Len loop
1644 Name_Buffer (J) := Sinput.Source (Loc);
1645 Loc := Loc + 1;
1646 end loop;
1648 Set_Display_Name_Of (Project, In_Tree, Name_Find);
1649 end;
1651 declare
1652 From_Ext : Extension_Origin := None;
1654 begin
1655 -- Extending_All is always propagated
1657 if From_Extended = Extending_All or else Extends_All then
1658 From_Ext := Extending_All;
1660 -- Otherwise, From_Extended is set to Extending_Single if the
1661 -- current project is an extending project.
1663 elsif Extended then
1664 From_Ext := Extending_Simple;
1665 end if;
1667 Post_Parse_Context_Clause
1668 (In_Tree => In_Tree,
1669 Context_Clause => First_With,
1670 In_Limited => In_Limited,
1671 Limited_Withs => False,
1672 Imported_Projects => Imported_Projects,
1673 Project_Directory => Project_Directory,
1674 From_Extended => From_Ext,
1675 Packages_To_Check => Packages_To_Check,
1676 Depth => Depth + 1,
1677 Current_Dir => Current_Dir,
1678 Is_Config_File => Is_Config_File,
1679 Env => Env);
1680 Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
1681 end;
1683 if not Is_Config_File then
1684 declare
1685 Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1686 Tree_Private_Part.Projects_Htable.Get_First
1687 (In_Tree.Projects_HT);
1688 Project_Name : Name_Id := Name_And_Node.Name;
1690 begin
1691 -- Check if we already have a project with this name
1693 while Project_Name /= No_Name
1694 and then Project_Name /= Name_Of_Project
1695 loop
1696 Name_And_Node :=
1697 Tree_Private_Part.Projects_Htable.Get_Next
1698 (In_Tree.Projects_HT);
1699 Project_Name := Name_And_Node.Name;
1700 end loop;
1702 -- Report an error if we already have a project with this name
1704 if Project_Name /= No_Name then
1705 Duplicated := True;
1706 Error_Msg_Name_1 := Project_Name;
1707 Error_Msg
1709 Location_Of (Project, In_Tree));
1710 Error_Msg_Name_1 :=
1711 Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
1712 Error_Msg
1713 (Env.Flags,
1715 end if;
1716 end;
1717 end if;
1719 end if;
1721 if Extending then
1724 if Token = Tok_String_Literal then
1725 Set_Extended_Project_Path_Of
1726 (Project,
1727 In_Tree,
1728 Path_Name_Type (Token_Name));
1730 declare
1731 Original_Path_Name : constant String :=
1732 Get_Name_String (Token_Name);
1734 Extended_Project_Path_Name_Id : Path_Name_Type;
1736 begin
1737 Find_Project
1738 (Env.Project_Path,
1739 Project_File_Name => Original_Path_Name,
1740 Directory => Get_Name_String (Project_Directory),
1741 Path => Extended_Project_Path_Name_Id);
1743 if Extended_Project_Path_Name_Id = No_Path then
1745 -- We could not find the project file to extend
1747 Error_Msg_Name_1 := Token_Name;
1751 -- If not in the main project file, display the import path
1753 if Project_Stack.Last > 1 then
1754 Error_Msg_Name_1 :=
1755 Name_Id
1756 (Project_Stack.Table (Project_Stack.Last).Path_Name);
1759 for Index in reverse 1 .. Project_Stack.Last - 1 loop
1760 Error_Msg_Name_1 :=
1761 Name_Id
1762 (Project_Stack.Table (Index).Path_Name);
1764 end loop;
1765 end if;
1767 else
1768 declare
1769 From_Ext : Extension_Origin := None;
1771 begin
1772 if From_Extended = Extending_All or else Extends_All then
1773 From_Ext := Extending_All;
1774 end if;
1776 Parse_Single_Project
1777 (In_Tree => In_Tree,
1778 Project => Extended_Project,
1779 Extends_All => Extends_All,
1780 Path_Name_Id => Extended_Project_Path_Name_Id,
1781 Extended => True,
1782 From_Extended => From_Ext,
1783 In_Limited => In_Limited,
1784 Packages_To_Check => Packages_To_Check,
1785 Depth => Depth + 1,
1786 Current_Dir => Current_Dir,
1787 Is_Config_File => Is_Config_File,
1788 Env => Env);
1789 end;
1791 if Present (Extended_Project) then
1793 if Project_Qualifier_Of (Extended_Project, In_Tree) =
1794 Aggregate
1795 then
1796 Error_Msg_Name_1 :=
1797 Name_Id (Path_Name_Of (Extended_Project, In_Tree));
1798 Error_Msg
1799 (Env.Flags,
1801 Location_Of (Project, In_Tree));
1802 end if;
1804 -- A project that extends an extending-all project is
1805 -- also an extending-all project.
1807 if Is_Extending_All (Extended_Project, In_Tree) then
1808 Set_Is_Extending_All (Project, In_Tree);
1809 end if;
1811 -- An abstract project can only extend an abstract
1812 -- project. Otherwise we may have an abstract project
1813 -- with sources if it inherits sources from the project
1814 -- it extends.
1816 if Project_Qualifier_Of (Project, In_Tree) =
1817 Abstract_Project
1818 and then
1819 Project_Qualifier_Of (Extended_Project, In_Tree) /=
1820 Abstract_Project
1821 then
1822 Error_Msg
1825 Qualifier_Location);
1826 end if;
1827 end if;
1828 end if;
1829 end;
1831 Scan (In_Tree); -- past the extended project path
1832 end if;
1833 end if;
1835 Check_Extending_All_Imports (Env.Flags, In_Tree, Project);
1836 Check_Aggregate_Imports (Env.Flags, In_Tree, Project);
1837 Check_Import_Aggregate (Env.Flags, In_Tree, Project);
1839 -- Check that a project with a name including a dot either imports
1840 -- or extends the project whose name precedes the last dot.
1842 if Name_Of_Project /= No_Name then
1843 Get_Name_String (Name_Of_Project);
1845 else
1846 Name_Len := 0;
1847 end if;
1849 -- Look for the last dot
1851 while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop
1852 Name_Len := Name_Len - 1;
1853 end loop;
1855 -- If a dot was found, check if parent project is imported or extended
1857 if Name_Len > 0 then
1858 Name_Len := Name_Len - 1;
1860 declare
1861 Parent_Name : constant Name_Id := Name_Find;
1862 Parent_Found : Boolean := False;
1863 Parent_Node : Project_Node_Id := Empty_Node;
1864 With_Clause : Project_Node_Id :=
1865 First_With_Clause_Of (Project, In_Tree);
1866 Imp_Proj_Name : Name_Id;
1868 begin
1869 -- If there is an extended project, check its name
1871 if Present (Extended_Project) then
1872 Parent_Node := Extended_Project;
1873 Parent_Found :=
1874 Name_Of (Extended_Project, In_Tree) = Parent_Name;
1875 end if;
1877 -- If the parent project is not the extended project,
1878 -- check each imported project until we find the parent project.
1880 Imported_Loop :
1881 while not Parent_Found and then Present (With_Clause) loop
1882 Parent_Node := Project_Node_Of (With_Clause, In_Tree);
1883 Extension_Loop : while Present (Parent_Node) loop
1884 Imp_Proj_Name := Name_Of (Parent_Node, In_Tree);
1885 Parent_Found := Imp_Proj_Name = Parent_Name;
1886 exit Imported_Loop when Parent_Found;
1887 Parent_Node :=
1888 Extended_Project_Of
1889 (Project_Declaration_Of (Parent_Node, In_Tree),
1890 In_Tree);
1891 end loop Extension_Loop;
1893 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1894 end loop Imported_Loop;
1896 if Parent_Found then
1897 Set_Parent_Project_Of (Project, In_Tree, To => Parent_Node);
1899 else
1900 -- If the parent project was not found, report an error
1902 Error_Msg_Name_1 := Name_Of_Project;
1903 Error_Msg_Name_2 := Parent_Name;
1904 Error_Msg (Env.Flags,
1906 Location_Of (Project, In_Tree));
1907 end if;
1908 end;
1909 end if;
1912 Set_End_Of_Line (Project);
1913 Set_Previous_Line_Node (Project);
1914 Set_Next_End_Node (Project);
1916 declare
1917 Project_Declaration : Project_Node_Id := Empty_Node;
1919 begin
1922 Prj.Dect.Parse
1923 (In_Tree => In_Tree,
1924 Declarations => Project_Declaration,
1925 Current_Project => Project,
1926 Extends => Extended_Project,
1927 Packages_To_Check => Packages_To_Check,
1928 Is_Config_File => Is_Config_File,
1929 Flags => Env.Flags);
1930 Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
1932 if Present (Extended_Project)
1933 and then Project_Qualifier_Of (Extended_Project, In_Tree) /=
1934 Abstract_Project
1935 then
1936 Set_Extending_Project_Of
1937 (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,
1938 To => Project);
1939 end if;
1940 end;
1943 Remove_Next_End_Node;
1947 if Token = Tok_End then
1948 Scan (In_Tree);
1949 end if;
1951 -- Clear the Buffer
1953 Buffer_Last := 0;
1956 -- several simple names.
1958 loop
1961 -- If we don't have an identifier, clear the buffer before exiting to
1962 -- avoid checking the name.
1964 if Token /= Tok_Identifier then
1965 Buffer_Last := 0;
1966 exit;
1967 end if;
1969 -- Add the identifier to the Buffer
1970 Get_Name_String (Token_Name);
1971 Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1973 -- Scan past the identifier
1975 Scan (In_Tree);
1976 exit when Token /= Tok_Dot;
1978 Scan (In_Tree);
1979 end loop;
1981 -- If we have a valid name, check if it is the name of the project
1983 if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
1984 if To_Lower (Buffer (1 .. Buffer_Last)) /=
1985 Get_Name_String (Name_Of (Project, In_Tree))
1986 then
1987 -- Invalid name: report an error
1991 Token_Ptr);
1992 end if;
1993 end if;
1997 -- Check that there is no more text following the end of the project
1998 -- source.
2000 if Token = Tok_Semicolon then
2001 Set_Previous_End_Node (Project);
2002 Scan (In_Tree);
2004 if Token /= Tok_EOF then
2005 Error_Msg
2006 (Env.Flags,
2008 end if;
2009 end if;
2011 if not Duplicated and then Name_Of_Project /= No_Name then
2013 -- Add the name of the project to the hash table, so that we can
2014 -- check that no other subsequent project will have the same name.
2016 Tree_Private_Part.Projects_Htable.Set
2017 (T => In_Tree.Projects_HT,
2018 K => Name_Of_Project,
2019 E => (Name => Name_Of_Project,
2020 Node => Project,
2021 Resolved_Path => Resolved_Path_Name,
2022 Extended => Extended,
2023 From_Extended => From_Extended /= None,
2024 Proj_Qualifier => Project_Qualifier_Of (Project, In_Tree)));
2025 end if;
2027 declare
2028 From_Ext : Extension_Origin := None;
2030 begin
2031 -- Extending_All is always propagated
2033 if From_Extended = Extending_All or else Extends_All then
2034 From_Ext := Extending_All;
2036 -- Otherwise, From_Extended is set to Extending_Single if the
2037 -- current project is an extending project.
2039 elsif Extended then
2040 From_Ext := Extending_Simple;
2041 end if;
2043 Post_Parse_Context_Clause
2044 (In_Tree => In_Tree,
2045 Context_Clause => First_With,
2046 In_Limited => In_Limited,
2047 Limited_Withs => True,
2048 Imported_Projects => Imported_Projects,
2049 Project_Directory => Project_Directory,
2050 From_Extended => From_Ext,
2051 Packages_To_Check => Packages_To_Check,
2052 Depth => Depth + 1,
2053 Current_Dir => Current_Dir,
2054 Is_Config_File => Is_Config_File,
2055 Env => Env);
2056 Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
2057 end;
2059 -- Restore the scan state, in case we are not the main project
2061 Restore_Project_Scan_State (Project_Scan_State);
2063 -- And remove the project from the project stack
2065 Project_Stack.Decrement_Last;
2067 -- Indicate if there are unkept comments
2069 Tree.Set_Project_File_Includes_Unkept_Comments
2070 (Node => Project,
2071 In_Tree => In_Tree,
2072 To => Tree.There_Are_Unkept_Comments);
2074 -- And restore the comment state that was saved
2076 Tree.Restore_And_Free (Project_Comment_State);
2078 Debug_Decrease_Indent;
2080 if Project /= Empty_Node and then Implicit_Project then
2081 Name_Len := 0;
2082 Add_Str_To_Name_Buffer (Current_Dir);
2083 Add_Char_To_Name_Buffer (Dir_Sep);
2084 In_Tree.Project_Nodes.Table (Project).Directory := Name_Find;
2085 end if;
2086 end Parse_Single_Project;
2088 -----------------------
2089 -- Project_Name_From --
2090 -----------------------
2092 function Project_Name_From
2093 (Path_Name : String;
2094 Is_Config_File : Boolean) return Name_Id
2095 is
2096 Canonical : String (1 .. Path_Name'Length) := Path_Name;
2097 First : Natural := Canonical'Last;
2098 Last : Natural := First;
2099 Index : Positive;
2101 begin
2102 if Current_Verbosity = High then
2104 end if;
2106 -- If the path name is empty, return No_Name to indicate failure
2108 if First = 0 then
2109 return No_Name;
2110 end if;
2112 Canonical_Case_File_Name (Canonical);
2114 -- Look for the last dot in the path name
2116 while First > 0
2117 and then
2118 Canonical (First) /= '.'
2119 loop
2120 First := First - 1;
2121 end loop;
2123 -- If we have a dot, check that it is followed by the correct extension
2125 if First > 0 and then Canonical (First) = '.' then
2126 if (not Is_Config_File
2127 and then Canonical (First .. Last) = Project_File_Extension
2128 and then First /= 1)
2129 or else
2130 (Is_Config_File
2131 and then
2132 Canonical (First .. Last) = Config_Project_File_Extension
2133 and then First /= 1)
2134 then
2135 -- Look for the last directory separator, if any
2137 First := First - 1;
2138 Last := First;
2139 while First > 0
2140 and then Canonical (First) /= '/'
2141 and then Canonical (First) /= Dir_Sep
2142 loop
2143 First := First - 1;
2144 end loop;
2146 else
2147 -- Not the correct extension, return No_Name to indicate failure
2149 return No_Name;
2150 end if;
2152 -- If no dot in the path name, return No_Name to indicate failure
2154 else
2155 return No_Name;
2156 end if;
2158 First := First + 1;
2160 -- If the extension is the file name, return No_Name to indicate failure
2162 if First > Last then
2163 return No_Name;
2164 end if;
2166 -- Put the name in lower case into Name_Buffer
2168 Name_Len := Last - First + 1;
2169 Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
2171 Index := 1;
2173 -- Check if it is a well formed project name. Return No_Name if it is
2174 -- ill formed.
2176 loop
2177 if not Is_Letter (Name_Buffer (Index)) then
2178 return No_Name;
2180 else
2181 loop
2182 Index := Index + 1;
2184 exit when Index >= Name_Len;
2186 if Name_Buffer (Index) = '_' then
2187 if Name_Buffer (Index + 1) = '_' then
2188 return No_Name;
2189 end if;
2190 end if;
2192 exit when Name_Buffer (Index) = '-';
2194 if Name_Buffer (Index) /= '_'
2195 and then not Is_Alphanumeric (Name_Buffer (Index))
2196 then
2197 return No_Name;
2198 end if;
2200 end loop;
2201 end if;
2203 if Index >= Name_Len then
2204 if Is_Alphanumeric (Name_Buffer (Name_Len)) then
2206 -- All checks have succeeded. Return name in Name_Buffer
2208 return Name_Find;
2210 else
2211 return No_Name;
2212 end if;
2214 elsif Name_Buffer (Index) = '-' then
2215 Index := Index + 1;
2216 end if;
2217 end loop;
2218 end Project_Name_From;
2220 end Prj.Part;