| blob | f1166afbb7301de5913a31e5a5664760fe42f130 |
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-2012, 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 ------------------------------------------------------------------------------
51 ------------------------------------
52 -- Local Packages and Subprograms --
53 ------------------------------------
65 -- Information about an imported project, to be put in table Withs below
74 -- Table used to store temporarily paths and locations of imported
75 -- projects. These imported projects will be effectively parsed later: just
76 -- before parsing the current project for the non limited withed projects,
77 -- after getting its name; after complete parsing of the current project
78 -- for the limited withed projects.
94 -- This table is used to detect circular dependencies
95 -- for imported and extended projects and to get the project ids of
96 -- limited imported projects when there is a circularity with at least
97 -- one limited imported project file.
106 -- Hash table to store the node ids of projects for which a virtual
107 -- extending project need to be created. The corresponding value is the
108 -- head of a list of WITH clauses corresponding to the context of the
109 -- enclosing EXTEND ALL projects. Note: Default_Element is Project_Node_
110 -- High_Bound because we want Empty_Node to be a possible value.
119 -- Hash table to store the project process when looking for project that
120 -- need to have a virtual extending project, to avoid processing the same
121 -- project twice.
123 function Has_Circular_Dependencies
127 -- Check for a circular dependency in the loaded project.
128 -- Generates an error message in such a case.
130 procedure Read_Project_Qualifier
136 -- Check if there is a qualifier before the reserved word "project"
138 -- Hash table to cache project path to avoid looking for them on the path
140 procedure Check_Extending_All_Imports
144 -- Check that a non extending-all project does not import an
145 -- extending-all project.
147 procedure Check_Aggregate_Imports
151 -- Check that an aggregate project only imports abstract projects
153 procedure Create_Virtual_Extending_Project
158 -- Create a virtual extending project of For_Project. Main_Project is
159 -- the extending all project. Extension_Withs is the head of a WITH clause
160 -- list to be added to the created virtual project.
161 --
162 -- The String_Value_Of is not set for the automatically added with
163 -- clause and keeps the default value of No_Name. This enables Prj.PP
164 -- to skip these automatically added with clauses to be processed.
166 procedure Look_For_Virtual_Projects_For
170 -- Look for projects that need to have a virtual extending project.
171 -- This procedure is recursive. If called with Potentially_Virtual set to
172 -- True, then Proj may need an virtual extending project; otherwise it
173 -- does not (because it is already extended), but other projects that it
174 -- imports may need to be virtually extended.
177 -- Type of parameter From_Extended for procedures Parse_Single_Project and
178 -- Post_Parse_Context_Clause. Extending_All means that we are parsing the
179 -- tree rooted at an extending all project.
181 procedure Parse_Single_Project
194 -- Parse a project file. This is a recursive procedure: it calls itself for
195 -- imported and extended projects. When From_Extended is not None, if the
196 -- project has already been parsed and is an extended project A, return the
197 -- ultimate (not extended) project that extends A. When In_Limited is True,
198 -- the importing path includes at least one "limited with". When parsing
199 -- configuration projects, do not allow a depth > 1.
200 --
201 -- Is_Config_File should be set to True if the project represents a config
202 -- file (.cgpr) since some specific checks apply.
204 procedure Pre_Parse_Context_Clause
209 -- Parse the context clause of a project. Store the paths and locations of
210 -- the imported projects in table Withs. Does nothing if there is no
211 -- context clause (if the current token is not "with" or "limited" followed
212 -- by "with").
213 -- Is_Config_File should be set to True if the project represents a config
214 -- file (.cgpr) since some specific checks apply.
216 procedure Post_Parse_Context_Clause
229 -- Parse the imported projects that have been stored in table Withs, if
230 -- any. From_Extended is used for the call to Parse_Single_Project below.
231 --
232 -- When In_Limited is True, the importing path includes at least one
233 -- "limited with". When Limited_Withs is False, only non limited withed
234 -- projects are parsed. When Limited_Withs is True, only limited withed
235 -- projects are parsed.
236 --
237 -- Is_Config_File should be set to True if the project represents a config
238 -- file (.cgpr) since some specific checks apply.
240 function Project_Name_From
243 -- Returns the name of the project that corresponds to its path name.
244 -- Returns No_Name if the path name is invalid, because the corresponding
245 -- project name does not have the syntax of an ada identifier.
247 function Copy_With_Clause
251 -- Return a copy of With_Clause in In_Tree, whose Next_With_Clause is the
252 -- indicated one.
254 ----------------------
255 -- Copy_With_Clause --
256 ----------------------
258 function Copy_With_Clause
262 is
265 begin
277 --------------------------------------
278 -- Create_Virtual_Extending_Project --
279 --------------------------------------
281 procedure Create_Virtual_Extending_Project
286 is
289 Virtual_Prefix &
291 -- The name of the virtual extending project
294 -- Virtual extending project name id
297 -- Fake path name of the virtual extending project. The directory is
298 -- the same directory as the extending all project.
300 -- The source of the virtual extending project is something like:
302 -- project V$<project name> extends <project path> is
304 -- for Source_Dirs use ();
306 -- end V$<project name>;
308 -- The project directory cannot be specified during parsing; it will be
309 -- put directly in the virtual extending project data during processing.
311 -- Nodes that made up the virtual extending project
315 Default_Project_Node
319 Default_Project_Node
322 Default_Project_Node
325 Default_Project_Node
328 Default_Project_Node
331 Default_Project_Node
334 begin
335 -- Get the virtual path name
342 loop
347 Virtual_Name;
351 -- Get the virtual name id
357 Virtual_Project := Create_Project
365 -- Add a WITH clause to the main project to import the newly created
366 -- virtual extending project.
371 Set_Next_With_Clause_Of
375 -- Copy with clauses for projects imported by the extending-all project
377 declare
381 begin
383 New_With_Clause :=
392 -- Virtual project node
394 Set_Location_Of
396 Set_Extended_Project_Path_Of
399 -- Project declaration
401 Set_First_Declarative_Item_Of
405 -- Source_Dirs declaration
407 Set_Current_Item_Node
410 -- Source_Dirs attribute
413 Set_Expression_Of
416 -- Source_Dirs expression
420 -- Source_Dirs term
424 -- Source_Dirs empty list: nothing to do
427 -----------------------------------
428 -- Look_For_Virtual_Projects_For --
429 -----------------------------------
432 -- Head of the current EXTENDS ALL imports list. When creating virtual
433 -- projects for an EXTENDS ALL, we import in each virtual project all
434 -- of the projects that appear in WITH clauses of the extending projects.
435 -- This ensures that virtual projects share a consistent environment (in
436 -- particular if a project imported by one of the extending projects
437 -- replaces some runtime units).
439 procedure Look_For_Virtual_Projects_For
443 is
445 -- Node for the project declaration of Proj
448 -- Node for a with clause of Proj
451 -- Node for a project imported by Proj
454 -- Node for the eventual project extended by Proj
457 -- Set True if Proj is an EXTENDS ALL project
461 begin
462 -- Nothing to do if Proj is undefined or has already been processed
466 -- Make sure the project will not be processed again
477 -- If this is a project that may need a virtual extending project
478 -- and it is not itself an extending project, put it in the list.
484 -- Now check the projects it imports
491 Look_For_Virtual_Projects_For
497 -- This is an EXTENDS ALL project: prepend each of its WITH
498 -- clauses to the currently active list of extension deps.
500 Extension_Withs :=
507 -- Check also the eventual project extended by Proj. As this project
508 -- is already extended, call recursively with Potentially_Virtual
509 -- being False.
511 Look_For_Virtual_Projects_For
518 -----------
519 -- Parse --
520 -----------
522 procedure Parse
533 is
538 Osint.To_Canonical_File_Spec
542 begin
552 end if;
554 Project := Empty_Node;
556 Find_Project (Env.Project_Path,
557 Project_File_Name => Real_Project_File_Name.all,
558 Directory => Current_Directory,
559 Path => Path_Name_Id);
560 Free (Real_Project_File_Name);
562 if Errout_Handling /= Never_Finalize then
563 Prj.Err.Initialize;
564 end if;
566 Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
567 Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
569 if Path_Name_Id = No_Path then
570 declare
571 P : String_Access;
572 begin
573 Get_Path (Env.Project_Path, Path => P);
575 Prj.Com.Fail
576 ("project file """
577 & Project_File_Name
578 & """ not found in "
579 & P.all);
580 Project := Empty_Node;
581 return;
582 end;
583 end if;
585 -- Parse the main project file
587 begin
588 Parse_Single_Project
589 (In_Tree => In_Tree,
590 Project => Project,
591 Extends_All => Dummy,
592 Path_Name_Id => Path_Name_Id,
593 Extended => False,
594 From_Extended => None,
595 In_Limited => False,
596 Packages_To_Check => Packages_To_Check,
597 Depth => 0,
598 Current_Dir => Current_Directory,
599 Is_Config_File => Is_Config_File,
600 Env => Env);
602 exception
603 when Types.Unrecoverable_Error =>
605 -- Unrecoverable_Error is raised when a line is too long.
606 -- A meaningful error message will be displayed later.
608 Project := Empty_Node;
609 end;
611 -- If Project is an extending-all project, create the eventual
612 -- virtual extending projects and check that there are no illegally
613 -- imported projects.
615 if Present (Project)
616 and then Is_Extending_All (Project, In_Tree)
617 then
618 -- First look for projects that potentially need a virtual
619 -- extending project.
621 Virtual_Hash.Reset;
622 Processed_Hash.Reset;
624 -- Mark the extending all project as processed, to avoid checking
625 -- the imported projects in case of a "limited with" on this
626 -- extending all project.
628 Processed_Hash.Set (Project, True);
630 declare
631 Declaration : constant Project_Node_Id :=
632 Project_Declaration_Of (Project, In_Tree);
633 begin
634 Extension_Withs := First_With_Clause_Of (Project, In_Tree);
635 Look_For_Virtual_Projects_For
636 (Extended_Project_Of (Declaration, In_Tree), In_Tree,
637 Potentially_Virtual => False);
638 end;
640 -- Now, check the projects directly imported by the main project.
641 -- Remove from the potentially virtual any project extended by one
642 -- of these imported projects.
644 declare
645 With_Clause : Project_Node_Id;
646 Imported : Project_Node_Id := Empty_Node;
647 Declaration : Project_Node_Id := Empty_Node;
649 begin
650 With_Clause := First_With_Clause_Of (Project, In_Tree);
651 while Present (With_Clause) loop
652 Imported := Project_Node_Of (With_Clause, In_Tree);
654 if Present (Imported) then
655 Declaration := Project_Declaration_Of (Imported, In_Tree);
657 if Extended_Project_Of (Declaration, In_Tree) /=
658 Empty_Node
659 then
660 loop
661 Imported :=
662 Extended_Project_Of (Declaration, In_Tree);
663 exit when No (Imported);
664 Virtual_Hash.Remove (Imported);
665 Declaration :=
666 Project_Declaration_Of (Imported, In_Tree);
667 end loop;
668 end if;
669 end if;
671 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
672 end loop;
673 end;
675 -- Now create all the virtual extending projects
677 declare
678 Proj : Project_Node_Id := Empty_Node;
679 Withs : Project_Node_Id;
680 begin
681 Virtual_Hash.Get_First (Proj, Withs);
682 while Withs /= Project_Node_High_Bound loop
683 Create_Virtual_Extending_Project
684 (Proj, Project, Withs, In_Tree);
685 Virtual_Hash.Get_Next (Proj, Withs);
686 end loop;
687 end;
688 end if;
690 -- If there were any kind of error during the parsing, serious
691 -- or not, then the parsing fails.
693 if Err_Vars.Total_Errors_Detected > 0 then
694 Project := Empty_Node;
695 end if;
697 case Errout_Handling is
698 when Always_Finalize =>
699 Prj.Err.Finalize;
701 -- Reinitialize to avoid duplicate warnings later on
702 Prj.Err.Initialize;
704 when Finalize_If_Error =>
705 if No (Project) then
706 Prj.Err.Finalize;
707 Prj.Err.Initialize;
708 end if;
710 when Never_Finalize =>
711 null;
712 end case;
714 exception
715 when X : others =>
717 -- Internal error
719 Write_Line (Exception_Information (X));
720 Write_Str ("Exception ");
721 Write_Str (Exception_Name (X));
722 Write_Line (" raised, while processing project file");
723 Project := Empty_Node;
724 end Parse;
726 ------------------------------
727 -- Pre_Parse_Context_Clause --
728 ------------------------------
730 procedure Pre_Parse_Context_Clause
731 (In_Tree : Project_Node_Tree_Ref;
732 Context_Clause : out With_Id;
733 Is_Config_File : Boolean;
734 Flags : Processing_Flags)
735 is
736 Current_With_Clause : With_Id := No_With;
737 Limited_With : Boolean := False;
738 Current_With : With_Record;
739 Current_With_Node : Project_Node_Id := Empty_Node;
741 begin
742 -- Assume no context clause
744 Context_Clause := No_With;
745 With_Loop :
747 -- If Token is not WITH or LIMITED, there is no context clause, or we
748 -- have exhausted the with clauses.
750 while Token = Tok_With or else Token = Tok_Limited loop
751 Current_With_Node :=
752 Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree);
753 Limited_With := Token = Tok_Limited;
755 if Is_Config_File then
756 Error_Msg
757 (Flags,
758 "configuration project cannot import " &
759 "other configuration projects",
760 Token_Ptr);
761 end if;
763 if Limited_With then
764 Scan (In_Tree); -- past LIMITED
765 Expect (Tok_With, "WITH");
766 exit With_Loop when Token /= Tok_With;
767 end if;
769 Comma_Loop :
770 loop
771 Scan (In_Tree); -- past WITH or ","
773 Expect (Tok_String_Literal, "literal string");
775 if Token /= Tok_String_Literal then
776 return;
777 end if;
779 -- Store path and location in table Withs
781 Current_With :=
782 (Path => Path_Name_Type (Token_Name),
783 Location => Token_Ptr,
784 Limited_With => Limited_With,
785 Node => Current_With_Node,
786 Next => No_With);
788 Withs.Increment_Last;
789 Withs.Table (Withs.Last) := Current_With;
791 if Current_With_Clause = No_With then
792 Context_Clause := Withs.Last;
794 else
795 Withs.Table (Current_With_Clause).Next := Withs.Last;
796 end if;
798 Current_With_Clause := Withs.Last;
800 Scan (In_Tree);
802 if Token = Tok_Semicolon then
803 Set_End_Of_Line (Current_With_Node);
804 Set_Previous_Line_Node (Current_With_Node);
806 -- End of (possibly multiple) with clause;
808 Scan (In_Tree); -- past semicolon
809 exit Comma_Loop;
811 elsif Token = Tok_Comma then
812 Set_Is_Not_Last_In_List (Current_With_Node, In_Tree);
814 else
815 Error_Msg (Flags, "expected comma or semi colon", Token_Ptr);
816 exit Comma_Loop;
817 end if;
819 Current_With_Node :=
820 Default_Project_Node
821 (Of_Kind => N_With_Clause, In_Tree => In_Tree);
822 end loop Comma_Loop;
823 end loop With_Loop;
824 end Pre_Parse_Context_Clause;
826 -------------------------------
827 -- Post_Parse_Context_Clause --
828 -------------------------------
830 procedure Post_Parse_Context_Clause
831 (Context_Clause : With_Id;
832 In_Tree : Project_Node_Tree_Ref;
833 In_Limited : Boolean;
834 Limited_Withs : Boolean;
835 Imported_Projects : in out Project_Node_Id;
836 Project_Directory : Path_Name_Type;
837 From_Extended : Extension_Origin;
838 Packages_To_Check : String_List_Access;
839 Depth : Natural;
840 Current_Dir : String;
841 Is_Config_File : Boolean;
842 Env : in out Environment)
843 is
844 Current_With_Clause : With_Id := Context_Clause;
846 Current_Project : Project_Node_Id := Imported_Projects;
847 Previous_Project : Project_Node_Id := Empty_Node;
848 Next_Project : Project_Node_Id := Empty_Node;
850 Project_Directory_Path : constant String :=
851 Get_Name_String (Project_Directory);
853 Current_With : With_Record;
854 Extends_All : Boolean := False;
855 Imported_Path_Name_Id : Path_Name_Type;
857 begin
858 -- Set Current_Project to the last project in the current list, if the
859 -- list is not empty.
861 if Present (Current_Project) then
862 while
863 Present (Next_With_Clause_Of (Current_Project, In_Tree))
864 loop
865 Current_Project := Next_With_Clause_Of (Current_Project, In_Tree);
866 end loop;
867 end if;
869 while Current_With_Clause /= No_With loop
870 Current_With := Withs.Table (Current_With_Clause);
871 Current_With_Clause := Current_With.Next;
873 if Limited_Withs = Current_With.Limited_With then
874 Find_Project
875 (Env.Project_Path,
876 Project_File_Name => Get_Name_String (Current_With.Path),
877 Directory => Project_Directory_Path,
878 Path => Imported_Path_Name_Id);
880 if Imported_Path_Name_Id = No_Path then
881 if Env.Flags.Ignore_Missing_With then
882 In_Tree.Incomplete_With := True;
884 else
885 -- The project file cannot be found
887 Error_Msg_File_1 := File_Name_Type (Current_With.Path);
888 Error_Msg
889 (Env.Flags, "unknown project file: {",
890 Current_With.Location);
892 -- If this is not imported by the main project file, display
893 -- the import path.
895 if Project_Stack.Last > 1 then
896 for Index in reverse 1 .. Project_Stack.Last loop
897 Error_Msg_File_1 :=
898 File_Name_Type
899 (Project_Stack.Table (Index).Path_Name);
900 Error_Msg
902 end loop;
903 end if;
904 end if;
906 else
907 -- New with clause
909 declare
910 Resolved_Path : constant String :=
911 Normalize_Pathname
912 (Get_Name_String (Imported_Path_Name_Id),
913 Directory => Current_Dir,
914 Resolve_Links =>
915 Opt.Follow_Links_For_Files,
916 Case_Sensitive => True);
918 Withed_Project : Project_Node_Id := Empty_Node;
920 begin
921 Previous_Project := Current_Project;
923 if No (Current_Project) then
925 -- First with clause of the context clause
927 Current_Project := Current_With.Node;
928 Imported_Projects := Current_Project;
930 else
931 Next_Project := Current_With.Node;
932 Set_Next_With_Clause_Of
933 (Current_Project, In_Tree, Next_Project);
934 Current_Project := Next_Project;
935 end if;
937 Set_String_Value_Of
938 (Current_Project,
939 In_Tree,
940 Name_Id (Current_With.Path));
941 Set_Location_Of
942 (Current_Project, In_Tree, Current_With.Location);
944 -- If it is a limited with, check if we have a circularity.
945 -- If we have one, get the project id of the limited
946 -- imported project file, and do not parse it.
948 if (In_Limited or Limited_Withs)
949 and then Project_Stack.Last > 1
950 then
951 declare
952 Canonical_Path_Name : Path_Name_Type;
954 begin
955 Name_Len := Resolved_Path'Length;
956 Name_Buffer (1 .. Name_Len) := Resolved_Path;
957 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
958 Canonical_Path_Name := Name_Find;
960 for Index in 1 .. Project_Stack.Last loop
961 if Project_Stack.Table (Index).Canonical_Path_Name =
962 Canonical_Path_Name
963 then
964 -- We have found the limited imported project,
965 -- get its project id, and do not parse it.
967 Withed_Project := Project_Stack.Table (Index).Id;
968 exit;
969 end if;
970 end loop;
971 end;
972 end if;
974 -- Parse the imported project if its project id is unknown
976 if No (Withed_Project) then
977 Parse_Single_Project
978 (In_Tree => In_Tree,
979 Project => Withed_Project,
980 Extends_All => Extends_All,
981 Path_Name_Id => Imported_Path_Name_Id,
982 Extended => False,
983 From_Extended => From_Extended,
984 In_Limited => In_Limited or Limited_Withs,
985 Packages_To_Check => Packages_To_Check,
986 Depth => Depth,
987 Current_Dir => Current_Dir,
988 Is_Config_File => Is_Config_File,
989 Env => Env);
991 else
992 Extends_All := Is_Extending_All (Withed_Project, In_Tree);
993 end if;
995 if No (Withed_Project) then
997 -- If parsing unsuccessful, remove the context clause
999 Current_Project := Previous_Project;
1001 if No (Current_Project) then
1002 Imported_Projects := Empty_Node;
1004 else
1005 Set_Next_With_Clause_Of
1006 (Current_Project, In_Tree, Empty_Node);
1007 end if;
1008 else
1009 -- If parsing was successful, record project name and
1010 -- path name in with clause
1012 Set_Project_Node_Of
1013 (Node => Current_Project,
1014 In_Tree => In_Tree,
1015 To => Withed_Project,
1016 Limited_With => Current_With.Limited_With);
1017 Set_Name_Of
1018 (Current_Project,
1019 In_Tree,
1020 Name_Of (Withed_Project, In_Tree));
1022 Name_Len := Resolved_Path'Length;
1023 Name_Buffer (1 .. Name_Len) := Resolved_Path;
1024 Set_Path_Name_Of (Current_Project, In_Tree, Name_Find);
1026 if Extends_All then
1027 Set_Is_Extending_All (Current_Project, In_Tree);
1028 end if;
1029 end if;
1030 end;
1031 end if;
1032 end if;
1033 end loop;
1034 end Post_Parse_Context_Clause;
1036 ---------------------------------
1037 -- Check_Extending_All_Imports --
1038 ---------------------------------
1040 procedure Check_Extending_All_Imports
1041 (Flags : Processing_Flags;
1042 In_Tree : Project_Node_Tree_Ref;
1043 Project : Project_Node_Id)
1044 is
1045 With_Clause : Project_Node_Id;
1046 Imported : Project_Node_Id;
1048 begin
1049 if not Is_Extending_All (Project, In_Tree) then
1050 With_Clause := First_With_Clause_Of (Project, In_Tree);
1051 while Present (With_Clause) loop
1052 Imported := Project_Node_Of (With_Clause, In_Tree);
1054 if Is_Extending_All (With_Clause, In_Tree) then
1055 Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
1056 Error_Msg (Flags, "cannot import extending-all project %%",
1057 Token_Ptr);
1058 exit;
1059 end if;
1061 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1062 end loop;
1063 end if;
1064 end Check_Extending_All_Imports;
1066 -----------------------------
1067 -- Check_Aggregate_Imports --
1068 -----------------------------
1070 procedure Check_Aggregate_Imports
1071 (Flags : Processing_Flags;
1072 In_Tree : Project_Node_Tree_Ref;
1073 Project : Project_Node_Id)
1074 is
1075 With_Clause, Imported : Project_Node_Id;
1076 begin
1077 if Project_Qualifier_Of (Project, In_Tree) = Aggregate then
1078 With_Clause := First_With_Clause_Of (Project, In_Tree);
1080 while Present (With_Clause) loop
1081 Imported := Project_Node_Of (With_Clause, In_Tree);
1083 if Project_Qualifier_Of (Imported, In_Tree) /= Dry then
1084 Error_Msg_Name_1 := Name_Id (Path_Name_Of (Imported, In_Tree));
1085 Error_Msg (Flags, "can only import abstract projects, not %%",
1086 Token_Ptr);
1087 exit;
1088 end if;
1090 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1091 end loop;
1092 end if;
1093 end Check_Aggregate_Imports;
1095 ----------------------------
1096 -- Read_Project_Qualifier --
1097 ----------------------------
1099 procedure Read_Project_Qualifier
1100 (Flags : Processing_Flags;
1101 In_Tree : Project_Node_Tree_Ref;
1102 Is_Config_File : Boolean;
1103 Qualifier_Location : out Source_Ptr;
1104 Project : Project_Node_Id)
1105 is
1106 Proj_Qualifier : Project_Qualifier := Unspecified;
1107 begin
1108 Qualifier_Location := Token_Ptr;
1110 if Token = Tok_Abstract then
1111 Proj_Qualifier := Dry;
1112 Scan (In_Tree);
1114 elsif Token = Tok_Identifier then
1115 case Token_Name is
1116 when Snames.Name_Standard =>
1117 Proj_Qualifier := Standard;
1118 Scan (In_Tree);
1120 when Snames.Name_Aggregate =>
1121 Proj_Qualifier := Aggregate;
1122 Scan (In_Tree);
1124 if Token = Tok_Identifier
1125 and then Token_Name = Snames.Name_Library
1126 then
1127 Proj_Qualifier := Aggregate_Library;
1128 Scan (In_Tree);
1129 end if;
1131 when Snames.Name_Library =>
1132 Proj_Qualifier := Library;
1133 Scan (In_Tree);
1135 when Snames.Name_Configuration =>
1136 if not Is_Config_File then
1137 Error_Msg
1138 (Flags,
1139 "configuration projects cannot belong to a user" &
1140 " project tree",
1141 Token_Ptr);
1142 end if;
1144 Proj_Qualifier := Configuration;
1145 Scan (In_Tree);
1147 when others =>
1148 null;
1149 end case;
1150 end if;
1152 if Is_Config_File and then Proj_Qualifier = Unspecified then
1154 -- Set the qualifier to Configuration, even if the token doesn't
1155 -- exist in the source file itself, so that we can differentiate
1156 -- project files and configuration files later on.
1158 Proj_Qualifier := Configuration;
1159 end if;
1161 if Proj_Qualifier /= Unspecified then
1162 if Is_Config_File
1163 and then Proj_Qualifier /= Configuration
1164 then
1165 Error_Msg (Flags,
1166 "a configuration project cannot be qualified except " &
1167 "as configuration project",
1168 Qualifier_Location);
1169 end if;
1171 Set_Project_Qualifier_Of (Project, In_Tree, Proj_Qualifier);
1172 end if;
1173 end Read_Project_Qualifier;
1175 -------------------------------
1176 -- Has_Circular_Dependencies --
1177 -------------------------------
1179 function Has_Circular_Dependencies
1180 (Flags : Processing_Flags;
1181 Normed_Path_Name : Path_Name_Type;
1182 Canonical_Path_Name : Path_Name_Type) return Boolean is
1183 begin
1184 for Index in reverse 1 .. Project_Stack.Last loop
1185 exit when Project_Stack.Table (Index).Limited_With;
1187 if Canonical_Path_Name =
1188 Project_Stack.Table (Index).Canonical_Path_Name
1189 then
1190 Error_Msg (Flags, "circular dependency detected", Token_Ptr);
1191 Error_Msg_Name_1 := Name_Id (Normed_Path_Name);
1194 for Current in reverse 1 .. Project_Stack.Last loop
1195 Error_Msg_Name_1 :=
1196 Name_Id (Project_Stack.Table (Current).Path_Name);
1198 if Project_Stack.Table (Current).Canonical_Path_Name /=
1199 Canonical_Path_Name
1200 then
1201 Error_Msg
1204 else
1206 exit;
1207 end if;
1208 end loop;
1210 return True;
1211 end if;
1212 end loop;
1213 return False;
1214 end Has_Circular_Dependencies;
1216 --------------------------
1217 -- Parse_Single_Project --
1218 --------------------------
1220 procedure Parse_Single_Project
1221 (In_Tree : Project_Node_Tree_Ref;
1222 Project : out Project_Node_Id;
1223 Extends_All : out Boolean;
1224 Path_Name_Id : Path_Name_Type;
1225 Extended : Boolean;
1226 From_Extended : Extension_Origin;
1227 In_Limited : Boolean;
1228 Packages_To_Check : String_List_Access;
1229 Depth : Natural;
1230 Current_Dir : String;
1231 Is_Config_File : Boolean;
1232 Env : in out Environment)
1233 is
1234 Path_Name : constant String := Get_Name_String (Path_Name_Id);
1236 Normed_Path_Name : Path_Name_Type;
1237 Canonical_Path_Name : Path_Name_Type;
1238 Project_Directory : Path_Name_Type;
1239 Project_Scan_State : Saved_Project_Scan_State;
1240 Source_Index : Source_File_Index;
1242 Extending : Boolean := False;
1244 Extended_Project : Project_Node_Id := Empty_Node;
1246 A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1247 Tree_Private_Part.Projects_Htable.Get_First
1248 (In_Tree.Projects_HT);
1250 Name_From_Path : constant Name_Id :=
1251 Project_Name_From (Path_Name, Is_Config_File => Is_Config_File);
1252 Name_Of_Project : Name_Id := No_Name;
1253 Display_Name_Of_Project : Name_Id := No_Name;
1255 Duplicated : Boolean := False;
1257 First_With : With_Id;
1258 Imported_Projects : Project_Node_Id := Empty_Node;
1260 use Tree_Private_Part;
1262 Project_Comment_State : Tree.Comment_State;
1264 Qualifier_Location : Source_Ptr;
1266 begin
1267 Extends_All := False;
1269 declare
1270 Normed_Path : constant String := Normalize_Pathname
1271 (Path_Name,
1272 Directory => Current_Dir,
1273 Resolve_Links => False,
1274 Case_Sensitive => True);
1275 Canonical_Path : constant String := Normalize_Pathname
1276 (Normed_Path,
1277 Directory => Current_Dir,
1278 Resolve_Links => Opt.Follow_Links_For_Files,
1279 Case_Sensitive => False);
1280 begin
1281 Name_Len := Normed_Path'Length;
1282 Name_Buffer (1 .. Name_Len) := Normed_Path;
1283 Normed_Path_Name := Name_Find;
1284 Name_Len := Canonical_Path'Length;
1285 Name_Buffer (1 .. Name_Len) := Canonical_Path;
1286 Canonical_Path_Name := Name_Find;
1287 end;
1289 if Has_Circular_Dependencies
1290 (Env.Flags, Normed_Path_Name, Canonical_Path_Name)
1291 then
1292 Project := Empty_Node;
1293 return;
1294 end if;
1296 -- Put the new path name on the stack
1298 Project_Stack.Append
1299 ((Path_Name => Normed_Path_Name,
1300 Canonical_Path_Name => Canonical_Path_Name,
1301 Id => Empty_Node,
1302 Limited_With => In_Limited));
1304 -- Check if the project file has already been parsed
1306 while
1307 A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
1308 loop
1309 if A_Project_Name_And_Node.Canonical_Path = Canonical_Path_Name then
1310 if Extended then
1312 if A_Project_Name_And_Node.Extended then
1313 if A_Project_Name_And_Node.Proj_Qualifier /= Dry then
1314 Error_Msg
1315 (Env.Flags,
1316 "cannot extend the same project file several times",
1317 Token_Ptr);
1318 end if;
1319 else
1320 Error_Msg
1321 (Env.Flags,
1322 "cannot extend an already imported project file",
1323 Token_Ptr);
1324 end if;
1326 elsif A_Project_Name_And_Node.Extended then
1327 Extends_All :=
1328 Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree);
1330 -- If the imported project is an extended project A, and we are
1331 -- in an extended project, replace A with the ultimate project
1332 -- extending A.
1334 if From_Extended /= None then
1335 declare
1336 Decl : Project_Node_Id :=
1337 Project_Declaration_Of
1338 (A_Project_Name_And_Node.Node, In_Tree);
1340 Prj : Project_Node_Id :=
1341 A_Project_Name_And_Node.Node;
1343 begin
1344 -- Loop through extending projects to find the ultimate
1345 -- extending project, that is the one that is not
1346 -- extended. For an abstract project, as it can be
1347 -- extended several times, there is no extending project
1348 -- registered, so the loop does not execute and the
1349 -- resulting project is the abstract project.
1351 while
1352 Extending_Project_Of (Decl, In_Tree) /= Empty_Node
1353 loop
1354 Prj := Extending_Project_Of (Decl, In_Tree);
1355 Decl := Project_Declaration_Of (Prj, In_Tree);
1356 end loop;
1358 A_Project_Name_And_Node.Node := Prj;
1359 end;
1360 else
1361 Error_Msg
1362 (Env.Flags,
1363 "cannot import an already extended project file",
1364 Token_Ptr);
1365 end if;
1366 end if;
1368 Project := A_Project_Name_And_Node.Node;
1369 Project_Stack.Decrement_Last;
1370 return;
1371 end if;
1373 A_Project_Name_And_Node :=
1374 Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT);
1375 end loop;
1377 -- We never encountered this project file. Save the scan state, load the
1378 -- project file and start to scan it.
1380 Save_Project_Scan_State (Project_Scan_State);
1381 Source_Index := Load_Project_File (Path_Name);
1382 Tree.Save (Project_Comment_State);
1384 -- If we cannot find it, we stop
1386 if Source_Index = No_Source_File then
1387 Project := Empty_Node;
1388 Project_Stack.Decrement_Last;
1389 return;
1390 end if;
1392 Prj.Err.Scanner.Initialize_Scanner (Source_Index);
1393 Tree.Reset_State;
1394 Scan (In_Tree);
1396 if not Is_Config_File and then Name_From_Path = No_Name then
1398 -- The project file name is not correct (no or bad extension, or not
1399 -- following Ada identifier's syntax).
1401 Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
1402 Error_Msg (Env.Flags,
1403 "?{ is not a valid path name for a project file",
1404 Token_Ptr);
1405 end if;
1407 if Current_Verbosity >= Medium then
1409 end if;
1411 Project_Directory :=
1412 Path_Name_Type (Get_Directory (File_Name_Type (Normed_Path_Name)));
1414 -- Is there any imported project?
1416 Pre_Parse_Context_Clause
1417 (In_Tree => In_Tree,
1418 Is_Config_File => Is_Config_File,
1419 Context_Clause => First_With,
1420 Flags => Env.Flags);
1422 Project := Default_Project_Node
1423 (Of_Kind => N_Project, In_Tree => In_Tree);
1424 Project_Stack.Table (Project_Stack.Last).Id := Project;
1425 Set_Directory_Of (Project, In_Tree, Project_Directory);
1426 Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name);
1428 Read_Project_Qualifier
1429 (Env.Flags, In_Tree, Is_Config_File, Qualifier_Location, Project);
1431 Set_Location_Of (Project, In_Tree, Token_Ptr);
1435 -- Mark location of PROJECT token if present
1437 if Token = Tok_Project then
1438 Scan (In_Tree); -- past PROJECT
1439 Set_Location_Of (Project, In_Tree, Token_Ptr);
1440 end if;
1442 -- Clear the Buffer
1444 Buffer_Last := 0;
1445 loop
1448 -- If the token is not an identifier, clear the buffer before
1449 -- exiting to indicate that the name of the project is ill-formed.
1451 if Token /= Tok_Identifier then
1452 Buffer_Last := 0;
1453 exit;
1454 end if;
1456 -- Add the identifier name to the buffer
1458 Get_Name_String (Token_Name);
1459 Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1461 -- Scan past the identifier
1463 Scan (In_Tree);
1465 -- If we have a dot, add a dot to the Buffer and look for the next
1466 -- identifier.
1468 exit when Token /= Tok_Dot;
1471 -- Scan past the dot
1473 Scan (In_Tree);
1474 end loop;
1476 -- See if this is an extending project
1478 if Token = Tok_Extends then
1480 if Is_Config_File then
1481 Error_Msg
1482 (Env.Flags,
1484 end if;
1486 -- Make sure that gnatmake will use mapping files
1488 Opt.Create_Mapping_File := True;
1490 -- We are extending another project
1492 Extending := True;
1494 Scan (In_Tree); -- past EXTENDS
1496 if Token = Tok_All then
1497 Extends_All := True;
1498 Set_Is_Extending_All (Project, In_Tree);
1499 Scan (In_Tree); -- scan past ALL
1500 end if;
1501 end if;
1503 -- If the name is well formed, Buffer_Last is > 0
1505 if Buffer_Last > 0 then
1507 -- The Buffer contains the name of the project
1509 Name_Len := Buffer_Last;
1510 Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
1511 Name_Of_Project := Name_Find;
1512 Set_Name_Of (Project, In_Tree, Name_Of_Project);
1514 -- To get expected name of the project file, replace dots by dashes
1516 for Index in 1 .. Name_Len loop
1517 if Name_Buffer (Index) = '.' then
1518 Name_Buffer (Index) := '-';
1519 end if;
1520 end loop;
1522 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1524 declare
1525 Expected_Name : constant Name_Id := Name_Find;
1526 Extension : String_Access;
1528 begin
1529 -- Output a warning if the actual name is not the expected name
1531 if not Is_Config_File
1532 and then (Name_From_Path /= No_Name)
1533 and then Expected_Name /= Name_From_Path
1534 then
1535 Error_Msg_Name_1 := Expected_Name;
1537 if Is_Config_File then
1538 Extension := new String'(Config_Project_File_Extension);
1540 else
1541 Extension := new String'(Project_File_Extension);
1542 end if;
1544 Error_Msg
1545 (Env.Flags,
1548 Token_Ptr);
1549 end if;
1550 end;
1552 -- Read the original casing of the project name
1554 declare
1555 Loc : Source_Ptr;
1557 begin
1558 Loc := Location_Of (Project, In_Tree);
1559 for J in 1 .. Name_Len loop
1560 Name_Buffer (J) := Sinput.Source (Loc);
1561 Loc := Loc + 1;
1562 end loop;
1564 Display_Name_Of_Project := Name_Find;
1565 end;
1567 declare
1568 From_Ext : Extension_Origin := None;
1570 begin
1571 -- Extending_All is always propagated
1573 if From_Extended = Extending_All or else Extends_All then
1574 From_Ext := Extending_All;
1576 -- Otherwise, From_Extended is set to Extending_Single if the
1577 -- current project is an extending project.
1579 elsif Extended then
1580 From_Ext := Extending_Simple;
1581 end if;
1583 Post_Parse_Context_Clause
1584 (In_Tree => In_Tree,
1585 Context_Clause => First_With,
1586 In_Limited => In_Limited,
1587 Limited_Withs => False,
1588 Imported_Projects => Imported_Projects,
1589 Project_Directory => Project_Directory,
1590 From_Extended => From_Ext,
1591 Packages_To_Check => Packages_To_Check,
1592 Depth => Depth + 1,
1593 Current_Dir => Current_Dir,
1594 Is_Config_File => Is_Config_File,
1595 Env => Env);
1596 Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
1597 end;
1599 if not Is_Config_File then
1600 declare
1601 Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1602 Tree_Private_Part.Projects_Htable.Get_First
1603 (In_Tree.Projects_HT);
1604 Project_Name : Name_Id := Name_And_Node.Name;
1606 begin
1607 -- Check if we already have a project with this name
1609 while Project_Name /= No_Name
1610 and then Project_Name /= Name_Of_Project
1611 loop
1612 Name_And_Node :=
1613 Tree_Private_Part.Projects_Htable.Get_Next
1614 (In_Tree.Projects_HT);
1615 Project_Name := Name_And_Node.Name;
1616 end loop;
1618 -- Report an error if we already have a project with this name
1620 if Project_Name /= No_Name then
1621 Duplicated := True;
1622 Error_Msg_Name_1 := Project_Name;
1623 Error_Msg
1625 Location_Of (Project, In_Tree));
1626 Error_Msg_Name_1 :=
1627 Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
1628 Error_Msg
1629 (Env.Flags,
1631 end if;
1632 end;
1633 end if;
1635 end if;
1637 if Extending then
1640 if Token = Tok_String_Literal then
1641 Set_Extended_Project_Path_Of
1642 (Project,
1643 In_Tree,
1644 Path_Name_Type (Token_Name));
1646 declare
1647 Original_Path_Name : constant String :=
1648 Get_Name_String (Token_Name);
1650 Extended_Project_Path_Name_Id : Path_Name_Type;
1652 begin
1653 Find_Project
1654 (Env.Project_Path,
1655 Project_File_Name => Original_Path_Name,
1656 Directory => Get_Name_String (Project_Directory),
1657 Path => Extended_Project_Path_Name_Id);
1659 if Extended_Project_Path_Name_Id = No_Path then
1661 -- We could not find the project file to extend
1663 Error_Msg_Name_1 := Token_Name;
1667 -- If not in the main project file, display the import path
1669 if Project_Stack.Last > 1 then
1670 Error_Msg_Name_1 :=
1671 Name_Id
1672 (Project_Stack.Table (Project_Stack.Last).Path_Name);
1675 for Index in reverse 1 .. Project_Stack.Last - 1 loop
1676 Error_Msg_Name_1 :=
1677 Name_Id
1678 (Project_Stack.Table (Index).Path_Name);
1680 end loop;
1681 end if;
1683 else
1684 declare
1685 From_Ext : Extension_Origin := None;
1687 begin
1688 if From_Extended = Extending_All or else Extends_All then
1689 From_Ext := Extending_All;
1690 end if;
1692 Parse_Single_Project
1693 (In_Tree => In_Tree,
1694 Project => Extended_Project,
1695 Extends_All => Extends_All,
1696 Path_Name_Id => Extended_Project_Path_Name_Id,
1697 Extended => True,
1698 From_Extended => From_Ext,
1699 In_Limited => In_Limited,
1700 Packages_To_Check => Packages_To_Check,
1701 Depth => Depth + 1,
1702 Current_Dir => Current_Dir,
1703 Is_Config_File => Is_Config_File,
1704 Env => Env);
1705 end;
1707 if Present (Extended_Project) then
1709 -- A project that extends an extending-all project is
1710 -- also an extending-all project.
1712 if Is_Extending_All (Extended_Project, In_Tree) then
1713 Set_Is_Extending_All (Project, In_Tree);
1714 end if;
1716 -- An abstract project can only extend an abstract
1717 -- project. Otherwise we may have an abstract project
1718 -- with sources if it inherits sources from the project
1719 -- it extends.
1721 if Project_Qualifier_Of (Project, In_Tree) = Dry and then
1722 Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
1723 then
1724 Error_Msg
1727 Qualifier_Location);
1728 end if;
1729 end if;
1730 end if;
1731 end;
1733 Scan (In_Tree); -- past the extended project path
1734 end if;
1735 end if;
1737 Check_Extending_All_Imports (Env.Flags, In_Tree, Project);
1738 Check_Aggregate_Imports (Env.Flags, In_Tree, Project);
1740 -- Check that a project with a name including a dot either imports
1741 -- or extends the project whose name precedes the last dot.
1743 if Name_Of_Project /= No_Name then
1744 Get_Name_String (Name_Of_Project);
1746 else
1747 Name_Len := 0;
1748 end if;
1750 -- Look for the last dot
1752 while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop
1753 Name_Len := Name_Len - 1;
1754 end loop;
1756 -- If a dot was found, check if parent project is imported or extended
1758 if Name_Len > 0 then
1759 Name_Len := Name_Len - 1;
1761 declare
1762 Parent_Name : constant Name_Id := Name_Find;
1763 Parent_Found : Boolean := False;
1764 Parent_Node : Project_Node_Id := Empty_Node;
1765 With_Clause : Project_Node_Id :=
1766 First_With_Clause_Of (Project, In_Tree);
1767 Imp_Proj_Name : Name_Id;
1769 begin
1770 -- If there is an extended project, check its name
1772 if Present (Extended_Project) then
1773 Parent_Node := Extended_Project;
1774 Parent_Found :=
1775 Name_Of (Extended_Project, In_Tree) = Parent_Name;
1776 end if;
1778 -- If the parent project is not the extended project,
1779 -- check each imported project until we find the parent project.
1781 Imported_Loop :
1782 while not Parent_Found and then Present (With_Clause) loop
1783 Parent_Node := Project_Node_Of (With_Clause, In_Tree);
1784 Extension_Loop : while Present (Parent_Node) loop
1785 Imp_Proj_Name := Name_Of (Parent_Node, In_Tree);
1786 Parent_Found := Imp_Proj_Name = Parent_Name;
1787 exit Imported_Loop when Parent_Found;
1788 Parent_Node :=
1789 Extended_Project_Of
1790 (Project_Declaration_Of (Parent_Node, In_Tree),
1791 In_Tree);
1792 end loop Extension_Loop;
1794 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1795 end loop Imported_Loop;
1797 if Parent_Found then
1798 Set_Parent_Project_Of (Project, In_Tree, To => Parent_Node);
1800 else
1801 -- If the parent project was not found, report an error
1803 Error_Msg_Name_1 := Name_Of_Project;
1804 Error_Msg_Name_2 := Parent_Name;
1805 Error_Msg (Env.Flags,
1807 Location_Of (Project, In_Tree));
1808 end if;
1809 end;
1810 end if;
1813 Set_End_Of_Line (Project);
1814 Set_Previous_Line_Node (Project);
1815 Set_Next_End_Node (Project);
1817 declare
1818 Project_Declaration : Project_Node_Id := Empty_Node;
1820 begin
1823 Prj.Dect.Parse
1824 (In_Tree => In_Tree,
1825 Declarations => Project_Declaration,
1826 Current_Project => Project,
1827 Extends => Extended_Project,
1828 Packages_To_Check => Packages_To_Check,
1829 Is_Config_File => Is_Config_File,
1830 Flags => Env.Flags);
1831 Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
1833 if Present (Extended_Project)
1834 and then Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
1835 then
1836 Set_Extending_Project_Of
1837 (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,
1838 To => Project);
1839 end if;
1840 end;
1843 Remove_Next_End_Node;
1847 if Token = Tok_End then
1848 Scan (In_Tree);
1849 end if;
1851 -- Clear the Buffer
1853 Buffer_Last := 0;
1856 -- several simple names.
1858 loop
1861 -- If we don't have an identifier, clear the buffer before exiting to
1862 -- avoid checking the name.
1864 if Token /= Tok_Identifier then
1865 Buffer_Last := 0;
1866 exit;
1867 end if;
1869 -- Add the identifier to the Buffer
1870 Get_Name_String (Token_Name);
1871 Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1873 -- Scan past the identifier
1875 Scan (In_Tree);
1876 exit when Token /= Tok_Dot;
1878 Scan (In_Tree);
1879 end loop;
1881 -- If we have a valid name, check if it is the name of the project
1883 if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
1884 if To_Lower (Buffer (1 .. Buffer_Last)) /=
1885 Get_Name_String (Name_Of (Project, In_Tree))
1886 then
1887 -- Invalid name: report an error
1891 Token_Ptr);
1892 end if;
1893 end if;
1897 -- Check that there is no more text following the end of the project
1898 -- source.
1900 if Token = Tok_Semicolon then
1901 Set_Previous_End_Node (Project);
1902 Scan (In_Tree);
1904 if Token /= Tok_EOF then
1905 Error_Msg
1906 (Env.Flags,
1908 end if;
1909 end if;
1911 if not Duplicated and then Name_Of_Project /= No_Name then
1913 -- Add the name of the project to the hash table, so that we can
1914 -- check that no other subsequent project will have the same name.
1916 Tree_Private_Part.Projects_Htable.Set
1917 (T => In_Tree.Projects_HT,
1918 K => Name_Of_Project,
1919 E => (Name => Name_Of_Project,
1920 Display_Name => Display_Name_Of_Project,
1921 Node => Project,
1922 Canonical_Path => Canonical_Path_Name,
1923 Extended => Extended,
1924 Proj_Qualifier => Project_Qualifier_Of (Project, In_Tree)));
1925 end if;
1927 declare
1928 From_Ext : Extension_Origin := None;
1930 begin
1931 -- Extending_All is always propagated
1933 if From_Extended = Extending_All or else Extends_All then
1934 From_Ext := Extending_All;
1936 -- Otherwise, From_Extended is set to Extending_Single if the
1937 -- current project is an extending project.
1939 elsif Extended then
1940 From_Ext := Extending_Simple;
1941 end if;
1943 Post_Parse_Context_Clause
1944 (In_Tree => In_Tree,
1945 Context_Clause => First_With,
1946 In_Limited => In_Limited,
1947 Limited_Withs => True,
1948 Imported_Projects => Imported_Projects,
1949 Project_Directory => Project_Directory,
1950 From_Extended => From_Ext,
1951 Packages_To_Check => Packages_To_Check,
1952 Depth => Depth + 1,
1953 Current_Dir => Current_Dir,
1954 Is_Config_File => Is_Config_File,
1955 Env => Env);
1956 Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
1957 end;
1959 -- Restore the scan state, in case we are not the main project
1961 Restore_Project_Scan_State (Project_Scan_State);
1963 -- And remove the project from the project stack
1965 Project_Stack.Decrement_Last;
1967 -- Indicate if there are unkept comments
1969 Tree.Set_Project_File_Includes_Unkept_Comments
1970 (Node => Project,
1971 In_Tree => In_Tree,
1972 To => Tree.There_Are_Unkept_Comments);
1974 -- And restore the comment state that was saved
1976 Tree.Restore_And_Free (Project_Comment_State);
1978 Debug_Decrease_Indent;
1979 end Parse_Single_Project;
1981 -----------------------
1982 -- Project_Name_From --
1983 -----------------------
1985 function Project_Name_From
1986 (Path_Name : String;
1987 Is_Config_File : Boolean) return Name_Id
1988 is
1989 Canonical : String (1 .. Path_Name'Length) := Path_Name;
1990 First : Natural := Canonical'Last;
1991 Last : Natural := First;
1992 Index : Positive;
1994 begin
1995 if Current_Verbosity = High then
1997 end if;
1999 -- If the path name is empty, return No_Name to indicate failure
2001 if First = 0 then
2002 return No_Name;
2003 end if;
2005 Canonical_Case_File_Name (Canonical);
2007 -- Look for the last dot in the path name
2009 while First > 0
2010 and then
2011 Canonical (First) /= '.'
2012 loop
2013 First := First - 1;
2014 end loop;
2016 -- If we have a dot, check that it is followed by the correct extension
2018 if First > 0 and then Canonical (First) = '.' then
2019 if (not Is_Config_File
2020 and then Canonical (First .. Last) = Project_File_Extension
2021 and then First /= 1)
2022 or else
2023 (Is_Config_File
2024 and then
2025 Canonical (First .. Last) = Config_Project_File_Extension
2026 and then First /= 1)
2027 then
2028 -- Look for the last directory separator, if any
2030 First := First - 1;
2031 Last := First;
2032 while First > 0
2033 and then Canonical (First) /= '/'
2034 and then Canonical (First) /= Dir_Sep
2035 loop
2036 First := First - 1;
2037 end loop;
2039 else
2040 -- Not the correct extension, return No_Name to indicate failure
2042 return No_Name;
2043 end if;
2045 -- If no dot in the path name, return No_Name to indicate failure
2047 else
2048 return No_Name;
2049 end if;
2051 First := First + 1;
2053 -- If the extension is the file name, return No_Name to indicate failure
2055 if First > Last then
2056 return No_Name;
2057 end if;
2059 -- Put the name in lower case into Name_Buffer
2061 Name_Len := Last - First + 1;
2062 Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
2064 Index := 1;
2066 -- Check if it is a well formed project name. Return No_Name if it is
2067 -- ill formed.
2069 loop
2070 if not Is_Letter (Name_Buffer (Index)) then
2071 return No_Name;
2073 else
2074 loop
2075 Index := Index + 1;
2077 exit when Index >= Name_Len;
2079 if Name_Buffer (Index) = '_' then
2080 if Name_Buffer (Index + 1) = '_' then
2081 return No_Name;
2082 end if;
2083 end if;
2085 exit when Name_Buffer (Index) = '-';
2087 if Name_Buffer (Index) /= '_'
2088 and then not Is_Alphanumeric (Name_Buffer (Index))
2089 then
2090 return No_Name;
2091 end if;
2093 end loop;
2094 end if;
2096 if Index >= Name_Len then
2097 if Is_Alphanumeric (Name_Buffer (Name_Len)) then
2099 -- All checks have succeeded. Return name in Name_Buffer
2101 return Name_Find;
2103 else
2104 return No_Name;
2105 end if;
2107 elsif Name_Buffer (Index) = '-' then
2108 Index := Index + 1;
2109 end if;
2110 end loop;
2111 end Project_Name_From;
2113 end Prj.Part;