| blob | 7f617a0e6dc881a402c1bcd3f6974378c4163718 |
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . P A R T --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
52 ------------------------------------
53 -- Local Packages and Subprograms --
54 ------------------------------------
66 -- Information about an imported project, to be put in table Withs below
75 -- Table used to store temporarily paths and locations of imported
76 -- projects. These imported projects will be effectively parsed later: just
77 -- before parsing the current project for the non limited withed projects,
78 -- after getting its name; after complete parsing of the current project
79 -- for the limited withed projects.
95 -- This table is used to detect circular dependencies
96 -- for imported and extended projects and to get the project ids of
97 -- limited imported projects when there is a circularity with at least
98 -- one limited imported project file.
107 -- Hash table to store the node ids of projects for which a virtual
108 -- extending project need to be created. The corresponding value is the
109 -- head of a list of WITH clauses corresponding to the context of the
110 -- enclosing EXTEND ALL projects. Note: Default_Element is Project_Node_
111 -- High_Bound because we want Empty_Node to be a possible value.
120 -- Hash table to store the project process when looking for project that
121 -- need to have a virtual extending project, to avoid processing the same
122 -- project twice.
124 function Has_Circular_Dependencies
128 -- Check for a circular dependency in the loaded project.
129 -- Generates an error message in such a case.
131 procedure Read_Project_Qualifier
137 -- Check if there is a qualifier before the reserved word "project"
139 -- Hash table to cache project path to avoid looking for them on the path
141 procedure Check_Extending_All_Imports
145 -- Check that a non extending-all project does not import an
146 -- extending-all project.
148 procedure Check_Aggregate_Imports
152 -- Check that an aggregate project only imports abstract projects
154 procedure Create_Virtual_Extending_Project
159 -- Create a virtual extending project of For_Project. Main_Project is
160 -- the extending all project. Extension_Withs is the head of a WITH clause
161 -- list to be added to the created virtual project.
162 --
163 -- The String_Value_Of is not set for the automatically added with
164 -- clause and keeps the default value of No_Name. This enables Prj.PP
165 -- to skip these automatically added with clauses to be processed.
167 procedure Look_For_Virtual_Projects_For
171 -- Look for projects that need to have a virtual extending project.
172 -- This procedure is recursive. If called with Potentially_Virtual set to
173 -- True, then Proj may need an virtual extending project; otherwise it
174 -- does not (because it is already extended), but other projects that it
175 -- imports may need to be virtually extended.
178 -- Type of parameter From_Extended for procedures Parse_Single_Project and
179 -- Post_Parse_Context_Clause. Extending_All means that we are parsing the
180 -- tree rooted at an extending all project.
182 procedure Parse_Single_Project
196 -- Parse a project file. This is a recursive procedure: it calls itself for
197 -- imported and extended projects. When From_Extended is not None, if the
198 -- project has already been parsed and is an extended project A, return the
199 -- ultimate (not extended) project that extends A. When In_Limited is True,
200 -- the importing path includes at least one "limited with". When parsing
201 -- configuration projects, do not allow a depth > 1.
202 --
203 -- Is_Config_File should be set to True if the project represents a config
204 -- file (.cgpr) since some specific checks apply.
205 --
206 -- If Implicit_Project is True, change the Directory of the project node
207 -- to be the Current_Dir. Recursive calls to Parse_Single_Project are
208 -- always done with the default False value for Implicit_Project.
210 procedure Pre_Parse_Context_Clause
215 -- Parse the context clause of a project. Store the paths and locations of
216 -- the imported projects in table Withs. Does nothing if there is no
217 -- context clause (if the current token is not "with" or "limited" followed
218 -- by "with").
219 -- Is_Config_File should be set to True if the project represents a config
220 -- file (.cgpr) since some specific checks apply.
222 procedure Post_Parse_Context_Clause
235 -- Parse the imported projects that have been stored in table Withs, if
236 -- any. From_Extended is used for the call to Parse_Single_Project below.
237 --
238 -- When In_Limited is True, the importing path includes at least one
239 -- "limited with". When Limited_Withs is False, only non limited withed
240 -- projects are parsed. When Limited_Withs is True, only limited withed
241 -- projects are parsed.
242 --
243 -- Is_Config_File should be set to True if the project represents a config
244 -- file (.cgpr) since some specific checks apply.
246 function Project_Name_From
249 -- Returns the name of the project that corresponds to its path name.
250 -- Returns No_Name if the path name is invalid, because the corresponding
251 -- project name does not have the syntax of an ada identifier.
253 function Copy_With_Clause
257 -- Return a copy of With_Clause in In_Tree, whose Next_With_Clause is the
258 -- indicated one.
260 ----------------------
261 -- Copy_With_Clause --
262 ----------------------
264 function Copy_With_Clause
268 is
271 begin
283 --------------------------------------
284 -- Create_Virtual_Extending_Project --
285 --------------------------------------
287 procedure Create_Virtual_Extending_Project
292 is
295 Virtual_Prefix &
297 -- The name of the virtual extending project
300 -- Virtual extending project name id
303 -- Fake path name of the virtual extending project. The directory is
304 -- the same directory as the extending all project.
306 -- The source of the virtual extending project is something like:
308 -- project V$<project name> extends <project path> is
310 -- for Source_Dirs use ();
312 -- end V$<project name>;
314 -- The project directory cannot be specified during parsing; it will be
315 -- put directly in the virtual extending project data during processing.
317 -- Nodes that made up the virtual extending project
321 Default_Project_Node
325 Default_Project_Node
328 Default_Project_Node
331 Default_Project_Node
334 Default_Project_Node
337 Default_Project_Node
340 begin
341 -- Get the virtual path name
348 loop
353 Virtual_Name;
357 -- Get the virtual name id
363 Virtual_Project := Create_Project
371 -- Add a WITH clause to the main project to import the newly created
372 -- virtual extending project.
377 Set_Next_With_Clause_Of
381 -- Copy with clauses for projects imported by the extending-all project
383 declare
387 begin
389 New_With_Clause :=
398 -- Virtual project node
400 Set_Location_Of
402 Set_Extended_Project_Path_Of
405 -- Project declaration
407 Set_First_Declarative_Item_Of
411 -- Source_Dirs declaration
413 Set_Current_Item_Node
416 -- Source_Dirs attribute
419 Set_Expression_Of
422 -- Source_Dirs expression
426 -- Source_Dirs term
430 -- Source_Dirs empty list: nothing to do
433 -----------------------------------
434 -- Look_For_Virtual_Projects_For --
435 -----------------------------------
438 -- Head of the current EXTENDS ALL imports list. When creating virtual
439 -- projects for an EXTENDS ALL, we import in each virtual project all
440 -- of the projects that appear in WITH clauses of the extending projects.
441 -- This ensures that virtual projects share a consistent environment (in
442 -- particular if a project imported by one of the extending projects
443 -- replaces some runtime units).
445 procedure Look_For_Virtual_Projects_For
449 is
451 -- Node for the project declaration of Proj
454 -- Node for a with clause of Proj
457 -- Node for a project imported by Proj
460 -- Node for the eventual project extended by Proj
463 -- Set True if Proj is an EXTENDS ALL project
467 begin
468 -- Nothing to do if Proj is undefined or has already been processed
472 -- Make sure the project will not be processed again
483 -- If this is a project that may need a virtual extending project
484 -- and it is not itself an extending project, put it in the list.
490 -- Now check the projects it imports
497 Look_For_Virtual_Projects_For
503 -- This is an EXTENDS ALL project: prepend each of its WITH
504 -- clauses to the currently active list of extension deps.
506 Extension_Withs :=
513 -- Check also the eventual project extended by Proj. As this project
514 -- is already extended, call recursively with Potentially_Virtual
515 -- being False.
517 Look_For_Virtual_Projects_For
524 -----------
525 -- Parse --
526 -----------
528 procedure Parse
540 is
545 Osint.To_Canonical_File_Spec
549 begin
559 end if;
561 Project := Empty_Node;
563 Find_Project (Env.Project_Path,
564 Project_File_Name => Real_Project_File_Name.all,
565 Directory => Current_Directory,
566 Path => Path_Name_Id);
567 Free (Real_Project_File_Name);
569 if Errout_Handling /= Never_Finalize then
570 Prj.Err.Initialize;
571 end if;
573 Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
574 Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
576 if Path_Name_Id = No_Path then
577 declare
578 P : String_Access;
579 begin
580 Get_Path (Env.Project_Path, Path => P);
582 Prj.Com.Fail
583 ("project file """
584 & Project_File_Name
585 & """ not found in "
586 & P.all);
587 Project := Empty_Node;
588 return;
589 end;
590 end if;
592 -- Parse the main project file
594 begin
595 Parse_Single_Project
596 (In_Tree => In_Tree,
597 Project => Project,
598 Extends_All => Dummy,
599 Path_Name_Id => Path_Name_Id,
600 Extended => False,
601 From_Extended => None,
602 In_Limited => False,
603 Packages_To_Check => Packages_To_Check,
604 Depth => 0,
605 Current_Dir => Current_Directory,
606 Is_Config_File => Is_Config_File,
607 Env => Env,
608 Implicit_Project => Implicit_Project);
610 exception
611 when Types.Unrecoverable_Error =>
613 -- Unrecoverable_Error is raised when a line is too long.
614 -- A meaningful error message will be displayed later.
616 Project := Empty_Node;
617 end;
619 -- If Project is an extending-all project, create the eventual
620 -- virtual extending projects and check that there are no illegally
621 -- imported projects.
623 if Present (Project)
624 and then Is_Extending_All (Project, In_Tree)
625 then
626 -- First look for projects that potentially need a virtual
627 -- extending project.
629 Virtual_Hash.Reset;
630 Processed_Hash.Reset;
632 -- Mark the extending all project as processed, to avoid checking
633 -- the imported projects in case of a "limited with" on this
634 -- extending all project.
636 Processed_Hash.Set (Project, True);
638 declare
639 Declaration : constant Project_Node_Id :=
640 Project_Declaration_Of (Project, In_Tree);
641 begin
642 Extension_Withs := First_With_Clause_Of (Project, In_Tree);
643 Look_For_Virtual_Projects_For
644 (Extended_Project_Of (Declaration, In_Tree), In_Tree,
645 Potentially_Virtual => False);
646 end;
648 -- Now, check the projects directly imported by the main project.
649 -- Remove from the potentially virtual any project extended by one
650 -- of these imported projects.
652 declare
653 With_Clause : Project_Node_Id;
654 Imported : Project_Node_Id := Empty_Node;
655 Declaration : Project_Node_Id := Empty_Node;
657 begin
658 With_Clause := First_With_Clause_Of (Project, In_Tree);
659 while Present (With_Clause) loop
660 Imported := Project_Node_Of (With_Clause, In_Tree);
662 if Present (Imported) then
663 Declaration := Project_Declaration_Of (Imported, In_Tree);
665 if Extended_Project_Of (Declaration, In_Tree) /=
666 Empty_Node
667 then
668 loop
669 Imported :=
670 Extended_Project_Of (Declaration, In_Tree);
671 exit when No (Imported);
672 Virtual_Hash.Remove (Imported);
673 Declaration :=
674 Project_Declaration_Of (Imported, In_Tree);
675 end loop;
676 end if;
677 end if;
679 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
680 end loop;
681 end;
683 -- Now create all the virtual extending projects
685 declare
686 Proj : Project_Node_Id := Empty_Node;
687 Withs : Project_Node_Id;
688 begin
689 Virtual_Hash.Get_First (Proj, Withs);
690 while Withs /= Project_Node_High_Bound loop
691 Create_Virtual_Extending_Project
692 (Proj, Project, Withs, In_Tree);
693 Virtual_Hash.Get_Next (Proj, Withs);
694 end loop;
695 end;
696 end if;
698 -- If there were any kind of error during the parsing, serious
699 -- or not, then the parsing fails.
701 if Total_Errors_Detected > 0 then
702 Project := Empty_Node;
703 end if;
705 case Errout_Handling is
706 when Always_Finalize =>
707 Prj.Err.Finalize;
709 -- Reinitialize to avoid duplicate warnings later on
710 Prj.Err.Initialize;
712 when Finalize_If_Error =>
713 if No (Project) then
714 Prj.Err.Finalize;
715 Prj.Err.Initialize;
716 end if;
718 when Never_Finalize =>
719 null;
720 end case;
722 exception
723 when X : others =>
725 -- Internal error
727 Write_Line (Exception_Information (X));
728 Write_Str ("Exception ");
729 Write_Str (Exception_Name (X));
730 Write_Line (" raised, while processing project file");
731 Project := Empty_Node;
732 end Parse;
734 ------------------------------
735 -- Pre_Parse_Context_Clause --
736 ------------------------------
738 procedure Pre_Parse_Context_Clause
739 (In_Tree : Project_Node_Tree_Ref;
740 Context_Clause : out With_Id;
741 Is_Config_File : Boolean;
742 Flags : Processing_Flags)
743 is
744 Current_With_Clause : With_Id := No_With;
745 Limited_With : Boolean := False;
746 Current_With : With_Record;
747 Current_With_Node : Project_Node_Id := Empty_Node;
749 begin
750 -- Assume no context clause
752 Context_Clause := No_With;
753 With_Loop :
755 -- If Token is not WITH or LIMITED, there is no context clause, or we
756 -- have exhausted the with clauses.
758 while Token = Tok_With or else Token = Tok_Limited loop
759 Current_With_Node :=
760 Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree);
761 Limited_With := Token = Tok_Limited;
763 if Is_Config_File then
764 Error_Msg
765 (Flags,
766 "configuration project cannot import " &
767 "other configuration projects",
768 Token_Ptr);
769 end if;
771 if Limited_With then
772 Scan (In_Tree); -- past LIMITED
773 Expect (Tok_With, "WITH");
774 exit With_Loop when Token /= Tok_With;
775 end if;
777 Comma_Loop :
778 loop
779 Scan (In_Tree); -- past WITH or ","
781 Expect (Tok_String_Literal, "literal string");
783 if Token /= Tok_String_Literal then
784 return;
785 end if;
787 -- Store path and location in table Withs
789 Current_With :=
790 (Path => Path_Name_Type (Token_Name),
791 Location => Token_Ptr,
792 Limited_With => Limited_With,
793 Node => Current_With_Node,
794 Next => No_With);
796 Withs.Increment_Last;
797 Withs.Table (Withs.Last) := Current_With;
799 if Current_With_Clause = No_With then
800 Context_Clause := Withs.Last;
802 else
803 Withs.Table (Current_With_Clause).Next := Withs.Last;
804 end if;
806 Current_With_Clause := Withs.Last;
808 Scan (In_Tree);
810 if Token = Tok_Semicolon then
811 Set_End_Of_Line (Current_With_Node);
812 Set_Previous_Line_Node (Current_With_Node);
814 -- End of (possibly multiple) with clause;
816 Scan (In_Tree); -- past semicolon
817 exit Comma_Loop;
819 elsif Token = Tok_Comma then
820 Set_Is_Not_Last_In_List (Current_With_Node, In_Tree);
822 else
823 Error_Msg (Flags, "expected comma or semi colon", Token_Ptr);
824 exit Comma_Loop;
825 end if;
827 Current_With_Node :=
828 Default_Project_Node
829 (Of_Kind => N_With_Clause, In_Tree => In_Tree);
830 end loop Comma_Loop;
831 end loop With_Loop;
832 end Pre_Parse_Context_Clause;
834 -------------------------------
835 -- Post_Parse_Context_Clause --
836 -------------------------------
838 procedure Post_Parse_Context_Clause
839 (Context_Clause : With_Id;
840 In_Tree : Project_Node_Tree_Ref;
841 In_Limited : Boolean;
842 Limited_Withs : Boolean;
843 Imported_Projects : in out Project_Node_Id;
844 Project_Directory : Path_Name_Type;
845 From_Extended : Extension_Origin;
846 Packages_To_Check : String_List_Access;
847 Depth : Natural;
848 Current_Dir : String;
849 Is_Config_File : Boolean;
850 Env : in out Environment)
851 is
852 Current_With_Clause : With_Id := Context_Clause;
854 Current_Project : Project_Node_Id := Imported_Projects;
855 Previous_Project : Project_Node_Id := Empty_Node;
856 Next_Project : Project_Node_Id := Empty_Node;
858 Project_Directory_Path : constant String :=
859 Get_Name_String (Project_Directory);
861 Current_With : With_Record;
862 Extends_All : Boolean := False;
863 Imported_Path_Name_Id : Path_Name_Type;
865 begin
866 -- Set Current_Project to the last project in the current list, if the
867 -- list is not empty.
869 if Present (Current_Project) then
870 while
871 Present (Next_With_Clause_Of (Current_Project, In_Tree))
872 loop
873 Current_Project := Next_With_Clause_Of (Current_Project, In_Tree);
874 end loop;
875 end if;
877 while Current_With_Clause /= No_With loop
878 Current_With := Withs.Table (Current_With_Clause);
879 Current_With_Clause := Current_With.Next;
881 if Limited_Withs = Current_With.Limited_With then
882 Find_Project
883 (Env.Project_Path,
884 Project_File_Name => Get_Name_String (Current_With.Path),
885 Directory => Project_Directory_Path,
886 Path => Imported_Path_Name_Id);
888 if Imported_Path_Name_Id = No_Path then
889 if Env.Flags.Ignore_Missing_With then
890 In_Tree.Incomplete_With := True;
892 else
893 -- The project file cannot be found
895 Error_Msg_File_1 := File_Name_Type (Current_With.Path);
896 Error_Msg
897 (Env.Flags, "unknown project file: {",
898 Current_With.Location);
900 -- If this is not imported by the main project file, display
901 -- the import path.
903 if Project_Stack.Last > 1 then
904 for Index in reverse 1 .. Project_Stack.Last loop
905 Error_Msg_File_1 :=
906 File_Name_Type
907 (Project_Stack.Table (Index).Path_Name);
908 Error_Msg
910 end loop;
911 end if;
912 end if;
914 else
915 -- New with clause
917 declare
918 Resolved_Path : constant String :=
919 Normalize_Pathname
920 (Get_Name_String (Imported_Path_Name_Id),
921 Directory => Current_Dir,
922 Resolve_Links =>
923 Opt.Follow_Links_For_Files,
924 Case_Sensitive => True);
926 Withed_Project : Project_Node_Id := Empty_Node;
928 begin
929 Previous_Project := Current_Project;
931 if No (Current_Project) then
933 -- First with clause of the context clause
935 Current_Project := Current_With.Node;
936 Imported_Projects := Current_Project;
938 else
939 Next_Project := Current_With.Node;
940 Set_Next_With_Clause_Of
941 (Current_Project, In_Tree, Next_Project);
942 Current_Project := Next_Project;
943 end if;
945 Set_String_Value_Of
946 (Current_Project,
947 In_Tree,
948 Name_Id (Current_With.Path));
949 Set_Location_Of
950 (Current_Project, In_Tree, Current_With.Location);
952 -- If it is a limited with, check if we have a circularity.
953 -- If we have one, get the project id of the limited
954 -- imported project file, and do not parse it.
956 if (In_Limited or Limited_Withs)
957 and then Project_Stack.Last > 1
958 then
959 declare
960 Canonical_Path_Name : Path_Name_Type;
962 begin
963 Name_Len := Resolved_Path'Length;
964 Name_Buffer (1 .. Name_Len) := Resolved_Path;
965 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
966 Canonical_Path_Name := Name_Find;
968 for Index in 1 .. Project_Stack.Last loop
969 if Project_Stack.Table (Index).Canonical_Path_Name =
970 Canonical_Path_Name
971 then
972 -- We have found the limited imported project,
973 -- get its project id, and do not parse it.
975 Withed_Project := Project_Stack.Table (Index).Id;
976 exit;
977 end if;
978 end loop;
979 end;
980 end if;
982 -- Parse the imported project if its project id is unknown
984 if No (Withed_Project) then
985 Parse_Single_Project
986 (In_Tree => In_Tree,
987 Project => Withed_Project,
988 Extends_All => Extends_All,
989 Path_Name_Id => Imported_Path_Name_Id,
990 Extended => False,
991 From_Extended => From_Extended,
992 In_Limited => In_Limited or Limited_Withs,
993 Packages_To_Check => Packages_To_Check,
994 Depth => Depth,
995 Current_Dir => Current_Dir,
996 Is_Config_File => Is_Config_File,
997 Env => Env);
999 else
1000 Extends_All := Is_Extending_All (Withed_Project, In_Tree);
1001 end if;
1003 if No (Withed_Project) then
1005 -- If parsing unsuccessful, remove the context clause
1007 Current_Project := Previous_Project;
1009 if No (Current_Project) then
1010 Imported_Projects := Empty_Node;
1012 else
1013 Set_Next_With_Clause_Of
1014 (Current_Project, In_Tree, Empty_Node);
1015 end if;
1016 else
1017 -- If parsing was successful, record project name and
1018 -- path name in with clause
1020 Set_Project_Node_Of
1021 (Node => Current_Project,
1022 In_Tree => In_Tree,
1023 To => Withed_Project,
1024 Limited_With => Current_With.Limited_With);
1025 Set_Name_Of
1026 (Current_Project,
1027 In_Tree,
1028 Name_Of (Withed_Project, In_Tree));
1030 Name_Len := Resolved_Path'Length;
1031 Name_Buffer (1 .. Name_Len) := Resolved_Path;
1032 Set_Path_Name_Of (Current_Project, In_Tree, Name_Find);
1034 if Extends_All then
1035 Set_Is_Extending_All (Current_Project, In_Tree);
1036 end if;
1037 end if;
1038 end;
1039 end if;
1040 end if;
1041 end loop;
1042 end Post_Parse_Context_Clause;
1044 ---------------------------------
1045 -- Check_Extending_All_Imports --
1046 ---------------------------------
1048 procedure Check_Extending_All_Imports
1049 (Flags : Processing_Flags;
1050 In_Tree : Project_Node_Tree_Ref;
1051 Project : Project_Node_Id)
1052 is
1053 With_Clause : Project_Node_Id;
1054 Imported : Project_Node_Id;
1056 begin
1057 if not Is_Extending_All (Project, In_Tree) then
1058 With_Clause := First_With_Clause_Of (Project, In_Tree);
1059 while Present (With_Clause) loop
1060 Imported := Project_Node_Of (With_Clause, In_Tree);
1062 if Is_Extending_All (With_Clause, In_Tree) then
1063 Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
1064 Error_Msg (Flags, "cannot import extending-all project %%",
1065 Token_Ptr);
1066 exit;
1067 end if;
1069 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1070 end loop;
1071 end if;
1072 end Check_Extending_All_Imports;
1074 -----------------------------
1075 -- Check_Aggregate_Imports --
1076 -----------------------------
1078 procedure Check_Aggregate_Imports
1079 (Flags : Processing_Flags;
1080 In_Tree : Project_Node_Tree_Ref;
1081 Project : Project_Node_Id)
1082 is
1083 With_Clause, Imported : Project_Node_Id;
1084 begin
1085 if Project_Qualifier_Of (Project, In_Tree) = Aggregate then
1086 With_Clause := First_With_Clause_Of (Project, In_Tree);
1088 while Present (With_Clause) loop
1089 Imported := Project_Node_Of (With_Clause, In_Tree);
1091 if Project_Qualifier_Of (Imported, In_Tree) /= Dry then
1092 Error_Msg_Name_1 := Name_Id (Path_Name_Of (Imported, In_Tree));
1093 Error_Msg (Flags, "can only import abstract projects, not %%",
1094 Token_Ptr);
1095 exit;
1096 end if;
1098 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1099 end loop;
1100 end if;
1101 end Check_Aggregate_Imports;
1103 ----------------------------
1104 -- Read_Project_Qualifier --
1105 ----------------------------
1107 procedure Read_Project_Qualifier
1108 (Flags : Processing_Flags;
1109 In_Tree : Project_Node_Tree_Ref;
1110 Is_Config_File : Boolean;
1111 Qualifier_Location : out Source_Ptr;
1112 Project : Project_Node_Id)
1113 is
1114 Proj_Qualifier : Project_Qualifier := Unspecified;
1115 begin
1116 Qualifier_Location := Token_Ptr;
1118 if Token = Tok_Abstract then
1119 Proj_Qualifier := Dry;
1120 Scan (In_Tree);
1122 elsif Token = Tok_Identifier then
1123 case Token_Name is
1124 when Snames.Name_Standard =>
1125 Proj_Qualifier := Standard;
1126 Scan (In_Tree);
1128 when Snames.Name_Aggregate =>
1129 Proj_Qualifier := Aggregate;
1130 Scan (In_Tree);
1132 if Token = Tok_Identifier
1133 and then Token_Name = Snames.Name_Library
1134 then
1135 Proj_Qualifier := Aggregate_Library;
1136 Scan (In_Tree);
1137 end if;
1139 when Snames.Name_Library =>
1140 Proj_Qualifier := Library;
1141 Scan (In_Tree);
1143 when Snames.Name_Configuration =>
1144 if not Is_Config_File then
1145 Error_Msg
1146 (Flags,
1147 "configuration projects cannot belong to a user" &
1148 " project tree",
1149 Token_Ptr);
1150 end if;
1152 Proj_Qualifier := Configuration;
1153 Scan (In_Tree);
1155 when others =>
1156 null;
1157 end case;
1158 end if;
1160 if Is_Config_File and then Proj_Qualifier = Unspecified then
1162 -- Set the qualifier to Configuration, even if the token doesn't
1163 -- exist in the source file itself, so that we can differentiate
1164 -- project files and configuration files later on.
1166 Proj_Qualifier := Configuration;
1167 end if;
1169 if Proj_Qualifier /= Unspecified then
1170 if Is_Config_File
1171 and then Proj_Qualifier /= Configuration
1172 then
1173 Error_Msg (Flags,
1174 "a configuration project cannot be qualified except " &
1175 "as configuration project",
1176 Qualifier_Location);
1177 end if;
1179 Set_Project_Qualifier_Of (Project, In_Tree, Proj_Qualifier);
1180 end if;
1181 end Read_Project_Qualifier;
1183 -------------------------------
1184 -- Has_Circular_Dependencies --
1185 -------------------------------
1187 function Has_Circular_Dependencies
1188 (Flags : Processing_Flags;
1189 Normed_Path_Name : Path_Name_Type;
1190 Canonical_Path_Name : Path_Name_Type) return Boolean is
1191 begin
1192 for Index in reverse 1 .. Project_Stack.Last loop
1193 exit when Project_Stack.Table (Index).Limited_With;
1195 if Canonical_Path_Name =
1196 Project_Stack.Table (Index).Canonical_Path_Name
1197 then
1198 Error_Msg (Flags, "circular dependency detected", Token_Ptr);
1199 Error_Msg_Name_1 := Name_Id (Normed_Path_Name);
1202 for Current in reverse 1 .. Project_Stack.Last loop
1203 Error_Msg_Name_1 :=
1204 Name_Id (Project_Stack.Table (Current).Path_Name);
1206 if Project_Stack.Table (Current).Canonical_Path_Name /=
1207 Canonical_Path_Name
1208 then
1209 Error_Msg
1212 else
1214 exit;
1215 end if;
1216 end loop;
1218 return True;
1219 end if;
1220 end loop;
1221 return False;
1222 end Has_Circular_Dependencies;
1224 --------------------------
1225 -- Parse_Single_Project --
1226 --------------------------
1228 procedure Parse_Single_Project
1229 (In_Tree : Project_Node_Tree_Ref;
1230 Project : out Project_Node_Id;
1231 Extends_All : out Boolean;
1232 Path_Name_Id : Path_Name_Type;
1233 Extended : Boolean;
1234 From_Extended : Extension_Origin;
1235 In_Limited : Boolean;
1236 Packages_To_Check : String_List_Access;
1237 Depth : Natural;
1238 Current_Dir : String;
1239 Is_Config_File : Boolean;
1240 Env : in out Environment;
1241 Implicit_Project : Boolean := False)
1242 is
1243 Path_Name : constant String := Get_Name_String (Path_Name_Id);
1245 Normed_Path_Name : Path_Name_Type;
1246 Canonical_Path_Name : Path_Name_Type;
1247 Project_Directory : Path_Name_Type;
1248 Project_Scan_State : Saved_Project_Scan_State;
1249 Source_Index : Source_File_Index;
1251 Extending : Boolean := False;
1253 Extended_Project : Project_Node_Id := Empty_Node;
1255 A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1256 Tree_Private_Part.Projects_Htable.Get_First
1257 (In_Tree.Projects_HT);
1259 Name_From_Path : constant Name_Id :=
1260 Project_Name_From (Path_Name, Is_Config_File => Is_Config_File);
1261 Name_Of_Project : Name_Id := No_Name;
1262 Display_Name_Of_Project : Name_Id := No_Name;
1264 Duplicated : Boolean := False;
1266 First_With : With_Id;
1267 Imported_Projects : Project_Node_Id := Empty_Node;
1269 use Tree_Private_Part;
1271 Project_Comment_State : Tree.Comment_State;
1273 Qualifier_Location : Source_Ptr;
1275 begin
1276 Extends_All := False;
1278 declare
1279 Normed_Path : constant String := Normalize_Pathname
1280 (Path_Name,
1281 Directory => Current_Dir,
1282 Resolve_Links => False,
1283 Case_Sensitive => True);
1284 Canonical_Path : constant String := Normalize_Pathname
1285 (Normed_Path,
1286 Directory => Current_Dir,
1287 Resolve_Links => Opt.Follow_Links_For_Files,
1288 Case_Sensitive => False);
1289 begin
1290 Name_Len := Normed_Path'Length;
1291 Name_Buffer (1 .. Name_Len) := Normed_Path;
1292 Normed_Path_Name := Name_Find;
1293 Name_Len := Canonical_Path'Length;
1294 Name_Buffer (1 .. Name_Len) := Canonical_Path;
1295 Canonical_Path_Name := Name_Find;
1296 end;
1298 if Has_Circular_Dependencies
1299 (Env.Flags, Normed_Path_Name, Canonical_Path_Name)
1300 then
1301 Project := Empty_Node;
1302 return;
1303 end if;
1305 -- Put the new path name on the stack
1307 Project_Stack.Append
1308 ((Path_Name => Normed_Path_Name,
1309 Canonical_Path_Name => Canonical_Path_Name,
1310 Id => Empty_Node,
1311 Limited_With => In_Limited));
1313 -- Check if the project file has already been parsed
1315 while
1316 A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
1317 loop
1318 if A_Project_Name_And_Node.Canonical_Path = Canonical_Path_Name then
1319 if Extended then
1321 if A_Project_Name_And_Node.Extended then
1322 if A_Project_Name_And_Node.Proj_Qualifier /= Dry then
1323 Error_Msg
1324 (Env.Flags,
1325 "cannot extend the same project file several times",
1326 Token_Ptr);
1327 end if;
1328 else
1329 Error_Msg
1330 (Env.Flags,
1331 "cannot extend an already imported project file",
1332 Token_Ptr);
1333 end if;
1335 elsif A_Project_Name_And_Node.Extended then
1336 Extends_All :=
1337 Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree);
1339 -- If the imported project is an extended project A, and we are
1340 -- in an extended project, replace A with the ultimate project
1341 -- extending A.
1343 if From_Extended /= None then
1344 declare
1345 Decl : Project_Node_Id :=
1346 Project_Declaration_Of
1347 (A_Project_Name_And_Node.Node, In_Tree);
1349 Prj : Project_Node_Id :=
1350 A_Project_Name_And_Node.Node;
1352 begin
1353 -- Loop through extending projects to find the ultimate
1354 -- extending project, that is the one that is not
1355 -- extended. For an abstract project, as it can be
1356 -- extended several times, there is no extending project
1357 -- registered, so the loop does not execute and the
1358 -- resulting project is the abstract project.
1360 while
1361 Extending_Project_Of (Decl, In_Tree) /= Empty_Node
1362 loop
1363 Prj := Extending_Project_Of (Decl, In_Tree);
1364 Decl := Project_Declaration_Of (Prj, In_Tree);
1365 end loop;
1367 A_Project_Name_And_Node.Node := Prj;
1368 end;
1369 else
1370 Error_Msg
1371 (Env.Flags,
1372 "cannot import an already extended project file",
1373 Token_Ptr);
1374 end if;
1375 end if;
1377 Project := A_Project_Name_And_Node.Node;
1378 Project_Stack.Decrement_Last;
1379 return;
1380 end if;
1382 A_Project_Name_And_Node :=
1383 Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT);
1384 end loop;
1386 -- We never encountered this project file. Save the scan state, load the
1387 -- project file and start to scan it.
1389 Save_Project_Scan_State (Project_Scan_State);
1390 Source_Index := Load_Project_File (Path_Name);
1391 Tree.Save (Project_Comment_State);
1393 -- If we cannot find it, we stop
1395 if Source_Index = No_Source_File then
1396 Project := Empty_Node;
1397 Project_Stack.Decrement_Last;
1398 return;
1399 end if;
1401 Prj.Err.Scanner.Initialize_Scanner (Source_Index);
1402 Tree.Reset_State;
1403 Scan (In_Tree);
1405 if not Is_Config_File
1406 and then Name_From_Path = No_Name
1407 and then not Implicit_Project
1408 then
1410 -- The project file name is not correct (no or bad extension, or not
1411 -- following Ada identifier's syntax).
1413 Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
1414 Error_Msg (Env.Flags,
1415 "?{ is not a valid path name for a project file",
1416 Token_Ptr);
1417 end if;
1419 if Current_Verbosity >= Medium then
1421 end if;
1423 Project_Directory :=
1424 Path_Name_Type (Get_Directory (File_Name_Type (Normed_Path_Name)));
1426 -- Is there any imported project?
1428 Pre_Parse_Context_Clause
1429 (In_Tree => In_Tree,
1430 Is_Config_File => Is_Config_File,
1431 Context_Clause => First_With,
1432 Flags => Env.Flags);
1434 Project := Default_Project_Node
1435 (Of_Kind => N_Project, In_Tree => In_Tree);
1436 Project_Stack.Table (Project_Stack.Last).Id := Project;
1437 Set_Directory_Of (Project, In_Tree, Project_Directory);
1438 Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name);
1440 Read_Project_Qualifier
1441 (Env.Flags, In_Tree, Is_Config_File, Qualifier_Location, Project);
1443 Set_Location_Of (Project, In_Tree, Token_Ptr);
1447 -- Mark location of PROJECT token if present
1449 if Token = Tok_Project then
1450 Scan (In_Tree); -- past PROJECT
1451 Set_Location_Of (Project, In_Tree, Token_Ptr);
1452 end if;
1454 -- Clear the Buffer
1456 Buffer_Last := 0;
1457 loop
1460 -- If the token is not an identifier, clear the buffer before
1461 -- exiting to indicate that the name of the project is ill-formed.
1463 if Token /= Tok_Identifier then
1464 Buffer_Last := 0;
1465 exit;
1466 end if;
1468 -- Add the identifier name to the buffer
1470 Get_Name_String (Token_Name);
1471 Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1473 -- Scan past the identifier
1475 Scan (In_Tree);
1477 -- If we have a dot, add a dot to the Buffer and look for the next
1478 -- identifier.
1480 exit when Token /= Tok_Dot;
1483 -- Scan past the dot
1485 Scan (In_Tree);
1486 end loop;
1488 -- See if this is an extending project
1490 if Token = Tok_Extends then
1492 if Is_Config_File then
1493 Error_Msg
1494 (Env.Flags,
1496 end if;
1498 -- Make sure that gnatmake will use mapping files
1500 Opt.Create_Mapping_File := True;
1502 -- We are extending another project
1504 Extending := True;
1506 Scan (In_Tree); -- past EXTENDS
1508 if Token = Tok_All then
1509 Extends_All := True;
1510 Set_Is_Extending_All (Project, In_Tree);
1511 Scan (In_Tree); -- scan past ALL
1512 end if;
1513 end if;
1515 -- If the name is well formed, Buffer_Last is > 0
1517 if Buffer_Last > 0 then
1519 -- The Buffer contains the name of the project
1521 Name_Len := Buffer_Last;
1522 Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
1523 Name_Of_Project := Name_Find;
1524 Set_Name_Of (Project, In_Tree, Name_Of_Project);
1526 -- To get expected name of the project file, replace dots by dashes
1528 for Index in 1 .. Name_Len loop
1529 if Name_Buffer (Index) = '.' then
1530 Name_Buffer (Index) := '-';
1531 end if;
1532 end loop;
1534 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1536 declare
1537 Expected_Name : constant Name_Id := Name_Find;
1538 Extension : String_Access;
1540 begin
1541 -- Output a warning if the actual name is not the expected name
1543 if not Is_Config_File
1544 and then (Name_From_Path /= No_Name)
1545 and then Expected_Name /= Name_From_Path
1546 then
1547 Error_Msg_Name_1 := Expected_Name;
1549 if Is_Config_File then
1550 Extension := new String'(Config_Project_File_Extension);
1552 else
1553 Extension := new String'(Project_File_Extension);
1554 end if;
1556 Error_Msg
1557 (Env.Flags,
1560 Token_Ptr);
1561 end if;
1562 end;
1564 -- Read the original casing of the project name
1566 declare
1567 Loc : Source_Ptr;
1569 begin
1570 Loc := Location_Of (Project, In_Tree);
1571 for J in 1 .. Name_Len loop
1572 Name_Buffer (J) := Sinput.Source (Loc);
1573 Loc := Loc + 1;
1574 end loop;
1576 Display_Name_Of_Project := Name_Find;
1577 end;
1579 declare
1580 From_Ext : Extension_Origin := None;
1582 begin
1583 -- Extending_All is always propagated
1585 if From_Extended = Extending_All or else Extends_All then
1586 From_Ext := Extending_All;
1588 -- Otherwise, From_Extended is set to Extending_Single if the
1589 -- current project is an extending project.
1591 elsif Extended then
1592 From_Ext := Extending_Simple;
1593 end if;
1595 Post_Parse_Context_Clause
1596 (In_Tree => In_Tree,
1597 Context_Clause => First_With,
1598 In_Limited => In_Limited,
1599 Limited_Withs => False,
1600 Imported_Projects => Imported_Projects,
1601 Project_Directory => Project_Directory,
1602 From_Extended => From_Ext,
1603 Packages_To_Check => Packages_To_Check,
1604 Depth => Depth + 1,
1605 Current_Dir => Current_Dir,
1606 Is_Config_File => Is_Config_File,
1607 Env => Env);
1608 Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
1609 end;
1611 if not Is_Config_File then
1612 declare
1613 Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1614 Tree_Private_Part.Projects_Htable.Get_First
1615 (In_Tree.Projects_HT);
1616 Project_Name : Name_Id := Name_And_Node.Name;
1618 begin
1619 -- Check if we already have a project with this name
1621 while Project_Name /= No_Name
1622 and then Project_Name /= Name_Of_Project
1623 loop
1624 Name_And_Node :=
1625 Tree_Private_Part.Projects_Htable.Get_Next
1626 (In_Tree.Projects_HT);
1627 Project_Name := Name_And_Node.Name;
1628 end loop;
1630 -- Report an error if we already have a project with this name
1632 if Project_Name /= No_Name then
1633 Duplicated := True;
1634 Error_Msg_Name_1 := Project_Name;
1635 Error_Msg
1637 Location_Of (Project, In_Tree));
1638 Error_Msg_Name_1 :=
1639 Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
1640 Error_Msg
1641 (Env.Flags,
1643 end if;
1644 end;
1645 end if;
1647 end if;
1649 if Extending then
1652 if Token = Tok_String_Literal then
1653 Set_Extended_Project_Path_Of
1654 (Project,
1655 In_Tree,
1656 Path_Name_Type (Token_Name));
1658 declare
1659 Original_Path_Name : constant String :=
1660 Get_Name_String (Token_Name);
1662 Extended_Project_Path_Name_Id : Path_Name_Type;
1664 begin
1665 Find_Project
1666 (Env.Project_Path,
1667 Project_File_Name => Original_Path_Name,
1668 Directory => Get_Name_String (Project_Directory),
1669 Path => Extended_Project_Path_Name_Id);
1671 if Extended_Project_Path_Name_Id = No_Path then
1673 -- We could not find the project file to extend
1675 Error_Msg_Name_1 := Token_Name;
1679 -- If not in the main project file, display the import path
1681 if Project_Stack.Last > 1 then
1682 Error_Msg_Name_1 :=
1683 Name_Id
1684 (Project_Stack.Table (Project_Stack.Last).Path_Name);
1687 for Index in reverse 1 .. Project_Stack.Last - 1 loop
1688 Error_Msg_Name_1 :=
1689 Name_Id
1690 (Project_Stack.Table (Index).Path_Name);
1692 end loop;
1693 end if;
1695 else
1696 declare
1697 From_Ext : Extension_Origin := None;
1699 begin
1700 if From_Extended = Extending_All or else Extends_All then
1701 From_Ext := Extending_All;
1702 end if;
1704 Parse_Single_Project
1705 (In_Tree => In_Tree,
1706 Project => Extended_Project,
1707 Extends_All => Extends_All,
1708 Path_Name_Id => Extended_Project_Path_Name_Id,
1709 Extended => True,
1710 From_Extended => From_Ext,
1711 In_Limited => In_Limited,
1712 Packages_To_Check => Packages_To_Check,
1713 Depth => Depth + 1,
1714 Current_Dir => Current_Dir,
1715 Is_Config_File => Is_Config_File,
1716 Env => Env);
1717 end;
1719 if Present (Extended_Project) then
1721 -- A project that extends an extending-all project is
1722 -- also an extending-all project.
1724 if Is_Extending_All (Extended_Project, In_Tree) then
1725 Set_Is_Extending_All (Project, In_Tree);
1726 end if;
1728 -- An abstract project can only extend an abstract
1729 -- project. Otherwise we may have an abstract project
1730 -- with sources if it inherits sources from the project
1731 -- it extends.
1733 if Project_Qualifier_Of (Project, In_Tree) = Dry and then
1734 Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
1735 then
1736 Error_Msg
1739 Qualifier_Location);
1740 end if;
1741 end if;
1742 end if;
1743 end;
1745 Scan (In_Tree); -- past the extended project path
1746 end if;
1747 end if;
1749 Check_Extending_All_Imports (Env.Flags, In_Tree, Project);
1750 Check_Aggregate_Imports (Env.Flags, In_Tree, Project);
1752 -- Check that a project with a name including a dot either imports
1753 -- or extends the project whose name precedes the last dot.
1755 if Name_Of_Project /= No_Name then
1756 Get_Name_String (Name_Of_Project);
1758 else
1759 Name_Len := 0;
1760 end if;
1762 -- Look for the last dot
1764 while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop
1765 Name_Len := Name_Len - 1;
1766 end loop;
1768 -- If a dot was found, check if parent project is imported or extended
1770 if Name_Len > 0 then
1771 Name_Len := Name_Len - 1;
1773 declare
1774 Parent_Name : constant Name_Id := Name_Find;
1775 Parent_Found : Boolean := False;
1776 Parent_Node : Project_Node_Id := Empty_Node;
1777 With_Clause : Project_Node_Id :=
1778 First_With_Clause_Of (Project, In_Tree);
1779 Imp_Proj_Name : Name_Id;
1781 begin
1782 -- If there is an extended project, check its name
1784 if Present (Extended_Project) then
1785 Parent_Node := Extended_Project;
1786 Parent_Found :=
1787 Name_Of (Extended_Project, In_Tree) = Parent_Name;
1788 end if;
1790 -- If the parent project is not the extended project,
1791 -- check each imported project until we find the parent project.
1793 Imported_Loop :
1794 while not Parent_Found and then Present (With_Clause) loop
1795 Parent_Node := Project_Node_Of (With_Clause, In_Tree);
1796 Extension_Loop : while Present (Parent_Node) loop
1797 Imp_Proj_Name := Name_Of (Parent_Node, In_Tree);
1798 Parent_Found := Imp_Proj_Name = Parent_Name;
1799 exit Imported_Loop when Parent_Found;
1800 Parent_Node :=
1801 Extended_Project_Of
1802 (Project_Declaration_Of (Parent_Node, In_Tree),
1803 In_Tree);
1804 end loop Extension_Loop;
1806 With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1807 end loop Imported_Loop;
1809 if Parent_Found then
1810 Set_Parent_Project_Of (Project, In_Tree, To => Parent_Node);
1812 else
1813 -- If the parent project was not found, report an error
1815 Error_Msg_Name_1 := Name_Of_Project;
1816 Error_Msg_Name_2 := Parent_Name;
1817 Error_Msg (Env.Flags,
1819 Location_Of (Project, In_Tree));
1820 end if;
1821 end;
1822 end if;
1825 Set_End_Of_Line (Project);
1826 Set_Previous_Line_Node (Project);
1827 Set_Next_End_Node (Project);
1829 declare
1830 Project_Declaration : Project_Node_Id := Empty_Node;
1832 begin
1835 Prj.Dect.Parse
1836 (In_Tree => In_Tree,
1837 Declarations => Project_Declaration,
1838 Current_Project => Project,
1839 Extends => Extended_Project,
1840 Packages_To_Check => Packages_To_Check,
1841 Is_Config_File => Is_Config_File,
1842 Flags => Env.Flags);
1843 Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
1845 if Present (Extended_Project)
1846 and then Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
1847 then
1848 Set_Extending_Project_Of
1849 (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,
1850 To => Project);
1851 end if;
1852 end;
1855 Remove_Next_End_Node;
1859 if Token = Tok_End then
1860 Scan (In_Tree);
1861 end if;
1863 -- Clear the Buffer
1865 Buffer_Last := 0;
1868 -- several simple names.
1870 loop
1873 -- If we don't have an identifier, clear the buffer before exiting to
1874 -- avoid checking the name.
1876 if Token /= Tok_Identifier then
1877 Buffer_Last := 0;
1878 exit;
1879 end if;
1881 -- Add the identifier to the Buffer
1882 Get_Name_String (Token_Name);
1883 Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1885 -- Scan past the identifier
1887 Scan (In_Tree);
1888 exit when Token /= Tok_Dot;
1890 Scan (In_Tree);
1891 end loop;
1893 -- If we have a valid name, check if it is the name of the project
1895 if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
1896 if To_Lower (Buffer (1 .. Buffer_Last)) /=
1897 Get_Name_String (Name_Of (Project, In_Tree))
1898 then
1899 -- Invalid name: report an error
1903 Token_Ptr);
1904 end if;
1905 end if;
1909 -- Check that there is no more text following the end of the project
1910 -- source.
1912 if Token = Tok_Semicolon then
1913 Set_Previous_End_Node (Project);
1914 Scan (In_Tree);
1916 if Token /= Tok_EOF then
1917 Error_Msg
1918 (Env.Flags,
1920 end if;
1921 end if;
1923 if not Duplicated and then Name_Of_Project /= No_Name then
1925 -- Add the name of the project to the hash table, so that we can
1926 -- check that no other subsequent project will have the same name.
1928 Tree_Private_Part.Projects_Htable.Set
1929 (T => In_Tree.Projects_HT,
1930 K => Name_Of_Project,
1931 E => (Name => Name_Of_Project,
1932 Display_Name => Display_Name_Of_Project,
1933 Node => Project,
1934 Canonical_Path => Canonical_Path_Name,
1935 Extended => Extended,
1936 Proj_Qualifier => Project_Qualifier_Of (Project, In_Tree)));
1937 end if;
1939 declare
1940 From_Ext : Extension_Origin := None;
1942 begin
1943 -- Extending_All is always propagated
1945 if From_Extended = Extending_All or else Extends_All then
1946 From_Ext := Extending_All;
1948 -- Otherwise, From_Extended is set to Extending_Single if the
1949 -- current project is an extending project.
1951 elsif Extended then
1952 From_Ext := Extending_Simple;
1953 end if;
1955 Post_Parse_Context_Clause
1956 (In_Tree => In_Tree,
1957 Context_Clause => First_With,
1958 In_Limited => In_Limited,
1959 Limited_Withs => True,
1960 Imported_Projects => Imported_Projects,
1961 Project_Directory => Project_Directory,
1962 From_Extended => From_Ext,
1963 Packages_To_Check => Packages_To_Check,
1964 Depth => Depth + 1,
1965 Current_Dir => Current_Dir,
1966 Is_Config_File => Is_Config_File,
1967 Env => Env);
1968 Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
1969 end;
1971 -- Restore the scan state, in case we are not the main project
1973 Restore_Project_Scan_State (Project_Scan_State);
1975 -- And remove the project from the project stack
1977 Project_Stack.Decrement_Last;
1979 -- Indicate if there are unkept comments
1981 Tree.Set_Project_File_Includes_Unkept_Comments
1982 (Node => Project,
1983 In_Tree => In_Tree,
1984 To => Tree.There_Are_Unkept_Comments);
1986 -- And restore the comment state that was saved
1988 Tree.Restore_And_Free (Project_Comment_State);
1990 Debug_Decrease_Indent;
1992 if Project /= Empty_Node and then Implicit_Project then
1993 Name_Len := 0;
1994 Add_Str_To_Name_Buffer (Current_Dir);
1995 Add_Char_To_Name_Buffer (Dir_Sep);
1996 In_Tree.Project_Nodes.Table (Project).Directory := Name_Find;
1997 end if;
1998 end Parse_Single_Project;
2000 -----------------------
2001 -- Project_Name_From --
2002 -----------------------
2004 function Project_Name_From
2005 (Path_Name : String;
2006 Is_Config_File : Boolean) return Name_Id
2007 is
2008 Canonical : String (1 .. Path_Name'Length) := Path_Name;
2009 First : Natural := Canonical'Last;
2010 Last : Natural := First;
2011 Index : Positive;
2013 begin
2014 if Current_Verbosity = High then
2016 end if;
2018 -- If the path name is empty, return No_Name to indicate failure
2020 if First = 0 then
2021 return No_Name;
2022 end if;
2024 Canonical_Case_File_Name (Canonical);
2026 -- Look for the last dot in the path name
2028 while First > 0
2029 and then
2030 Canonical (First) /= '.'
2031 loop
2032 First := First - 1;
2033 end loop;
2035 -- If we have a dot, check that it is followed by the correct extension
2037 if First > 0 and then Canonical (First) = '.' then
2038 if (not Is_Config_File
2039 and then Canonical (First .. Last) = Project_File_Extension
2040 and then First /= 1)
2041 or else
2042 (Is_Config_File
2043 and then
2044 Canonical (First .. Last) = Config_Project_File_Extension
2045 and then First /= 1)
2046 then
2047 -- Look for the last directory separator, if any
2049 First := First - 1;
2050 Last := First;
2051 while First > 0
2052 and then Canonical (First) /= '/'
2053 and then Canonical (First) /= Dir_Sep
2054 loop
2055 First := First - 1;
2056 end loop;
2058 else
2059 -- Not the correct extension, return No_Name to indicate failure
2061 return No_Name;
2062 end if;
2064 -- If no dot in the path name, return No_Name to indicate failure
2066 else
2067 return No_Name;
2068 end if;
2070 First := First + 1;
2072 -- If the extension is the file name, return No_Name to indicate failure
2074 if First > Last then
2075 return No_Name;
2076 end if;
2078 -- Put the name in lower case into Name_Buffer
2080 Name_Len := Last - First + 1;
2081 Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
2083 Index := 1;
2085 -- Check if it is a well formed project name. Return No_Name if it is
2086 -- ill formed.
2088 loop
2089 if not Is_Letter (Name_Buffer (Index)) then
2090 return No_Name;
2092 else
2093 loop
2094 Index := Index + 1;
2096 exit when Index >= Name_Len;
2098 if Name_Buffer (Index) = '_' then
2099 if Name_Buffer (Index + 1) = '_' then
2100 return No_Name;
2101 end if;
2102 end if;
2104 exit when Name_Buffer (Index) = '-';
2106 if Name_Buffer (Index) /= '_'
2107 and then not Is_Alphanumeric (Name_Buffer (Index))
2108 then
2109 return No_Name;
2110 end if;
2112 end loop;
2113 end if;
2115 if Index >= Name_Len then
2116 if Is_Alphanumeric (Name_Buffer (Name_Len)) then
2118 -- All checks have succeeded. Return name in Name_Buffer
2120 return Name_Find;
2122 else
2123 return No_Name;
2124 end if;
2126 elsif Name_Buffer (Index) = '-' then
2127 Index := Index + 1;
2128 end if;
2129 end loop;
2130 end Project_Name_From;
2132 end Prj.Part;