1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 2000-2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
27 ------------------------------------------------------------------------------
29 with Ada.Characters.Handling; use Ada.Characters.Handling;
30 with Ada.Strings; use Ada.Strings;
31 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
32 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
33 with Errout; use Errout;
34 with GNAT.Case_Util; use GNAT.Case_Util;
35 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
36 with GNAT.OS_Lib; use GNAT.OS_Lib;
38 with Namet; use Namet;
39 with Osint; use Osint;
40 with Output; use Output;
41 with Prj.Com; use Prj.Com;
42 with Prj.Util; use Prj.Util;
43 with Snames; use Snames;
44 with Stringt; use Stringt;
45 with Types; use Types;
47 package body Prj.Nmsc is
49 Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
51 Error_Report : Put_Line_Access := null;
53 procedure Check_Ada_Naming_Scheme (Naming : Naming_Data);
54 -- Check that the package Naming is correct.
56 procedure Check_Ada_Name
59 -- Check that a name is a valid Ada unit name.
61 procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
62 -- Output an error message. If Error_Report is null, simply call
63 -- Errout.Error_Msg. Otherwise, disregard Flag_Location and use
66 function Get_Name_String (S : String_Id) return String;
67 -- Get the string from a String_Id
72 Unit_Name : out Name_Id;
73 Unit_Kind : out Spec_Or_Body;
74 Needs_Pragma : out Boolean);
75 -- Find out, from a file name, the unit name, the unit kind and if a
76 -- specific SFN pragma is needed. If the file name corresponds to no
77 -- unit, then Unit_Name will be No_Name.
79 function Is_Illegal_Append (This : String) return Boolean;
80 -- Returns True if the string This cannot be used as
81 -- a Specification_Append, a Body_Append or a Separate_Append.
83 procedure Record_Source
87 Data : in out Project_Data;
88 Location : Source_Ptr;
89 Current_Source : in out String_List_Id);
90 -- Put a unit in the list of units of a project, if the file name
91 -- corresponds to a valid unit name.
93 procedure Show_Source_Dirs (Project : Project_Id);
94 -- List all the source directories of a project.
96 function Locate_Directory
100 -- Locate a directory.
101 -- Returns No_Name if directory does not exist.
103 function Path_Name_Of
104 (File_Name : String_Id;
107 -- Returns the path name of a (non project) file.
108 -- Returns an empty string if file cannot be found.
110 function Path_Name_Of
111 (File_Name : String_Id;
112 Directory : String_Id)
114 -- Same as above except that Directory is a String_Id instead
122 (Project : Project_Id;
123 Report_Error : Put_Line_Access)
126 Languages : Variable_Value := Nil_Variable_Value;
128 procedure Check_Unit_Names (List : Array_Element_Id);
129 -- Check that a list of unit names contains only valid names.
131 procedure Find_Sources;
132 -- Find all the sources in all of the source directories
135 procedure Get_Path_Name_And_Record_Source
137 Location : Source_Ptr;
138 Current_Source : in out String_List_Id);
139 -- Find the path name of a source in the source directories and
140 -- record the source, if found.
142 procedure Get_Sources_From_File
144 Location : Source_Ptr);
145 -- Get the sources of a project from a text file
147 ----------------------
148 -- Check_Unit_Names --
149 ----------------------
151 procedure Check_Unit_Names (List : Array_Element_Id) is
152 Current : Array_Element_Id := List;
153 Element : Array_Element;
157 -- Loop through elements of the string list
159 while Current /= No_Array_Element loop
160 Element := Array_Elements.Table (Current);
162 -- Check that it contains a valid unit name
164 Check_Ada_Name (Element.Index, Unit_Name);
166 if Unit_Name = No_Name then
167 Error_Msg_Name_1 := Element.Index;
169 ("{ is not a valid unit name.",
170 Element.Value.Location);
173 if Current_Verbosity = High then
174 Write_Str (" Body_Part (""");
175 Write_Str (Get_Name_String (Unit_Name));
179 Element.Index := Unit_Name;
180 Array_Elements.Table (Current) := Element;
183 Current := Element.Next;
185 end Check_Unit_Names;
191 procedure Find_Sources is
192 Source_Dir : String_List_Id := Data.Source_Dirs;
193 Element : String_Element;
195 Current_Source : String_List_Id := Nil_String;
198 if Current_Verbosity = High then
199 Write_Line ("Looking for sources:");
202 -- For each subdirectory
204 while Source_Dir /= Nil_String loop
206 Element := String_Elements.Table (Source_Dir);
207 if Element.Value /= No_String then
209 Source_Directory : String
210 (1 .. Integer (String_Length (Element.Value)));
212 String_To_Name_Buffer (Element.Value);
213 Source_Directory := Name_Buffer (1 .. Name_Len);
214 if Current_Verbosity = High then
215 Write_Str ("Source_Dir = ");
216 Write_Line (Source_Directory);
219 -- We look to every entry in the source directory
221 Open (Dir, Source_Directory);
224 Read (Dir, Name_Buffer, Name_Len);
226 if Current_Verbosity = High then
227 Write_Str (" Checking ");
228 Write_Line (Name_Buffer (1 .. Name_Len));
231 exit when Name_Len = 0;
234 Path_Access : constant GNAT.OS_Lib.String_Access :=
236 (Name_Buffer (1 .. Name_Len),
243 -- If it is a regular file
245 if Path_Access /= null then
246 File_Name := Name_Find;
247 Name_Len := Path_Access'Length;
248 Name_Buffer (1 .. Name_Len) := Path_Access.all;
249 Path_Name := Name_Find;
251 -- We attempt to register it as a source.
252 -- However, there is no error if the file
253 -- does not contain a valid source.
254 -- But there is an error if we have a
255 -- duplicate unit name.
258 (File_Name => File_Name,
259 Path_Name => Path_Name,
262 Location => No_Location,
263 Current_Source => Current_Source);
266 if Current_Verbosity = High then
268 (" Not a regular file.");
279 when Directory_Error =>
283 Source_Dir := Element.Next;
286 if Current_Verbosity = High then
287 Write_Line ("end Looking for sources.");
290 -- If we have looked for sources and found none, then
291 -- it is an error. If a project is not supposed to contain
292 -- any source, then we never call Find_Sources.
294 if Current_Source = Nil_String then
295 Error_Msg ("there are no sources in this project",
300 -------------------------------------
301 -- Get_Path_Name_And_Record_Source --
302 -------------------------------------
304 procedure Get_Path_Name_And_Record_Source
306 Location : Source_Ptr;
307 Current_Source : in out String_List_Id)
309 Source_Dir : String_List_Id := Data.Source_Dirs;
310 Element : String_Element;
311 Path_Name : GNAT.OS_Lib.String_Access;
312 Found : Boolean := False;
316 if Current_Verbosity = High then
317 Write_Str (" Checking """);
318 Write_Str (File_Name);
322 -- We look in all source directories for this file name
324 while Source_Dir /= Nil_String loop
325 Element := String_Elements.Table (Source_Dir);
327 if Current_Verbosity = High then
329 Write_Str (Get_Name_String (Element.Value));
336 Get_Name_String (Element.Value));
338 if Path_Name /= null then
339 if Current_Verbosity = High then
343 Name_Len := File_Name'Length;
344 Name_Buffer (1 .. Name_Len) := File_Name;
346 Name_Len := Path_Name'Length;
347 Name_Buffer (1 .. Name_Len) := Path_Name.all;
349 -- Register the source. Report an error if the file does not
350 -- correspond to a source.
354 Path_Name => Name_Find,
357 Location => Location,
358 Current_Source => Current_Source);
363 if Current_Verbosity = High then
367 Source_Dir := Element.Next;
371 end Get_Path_Name_And_Record_Source;
373 ---------------------------
374 -- Get_Sources_From_File --
375 ---------------------------
377 procedure Get_Sources_From_File
379 Location : Source_Ptr)
381 File : Prj.Util.Text_File;
382 Line : String (1 .. 250);
384 Current_Source : String_List_Id := Nil_String;
386 Nmb_Errors : constant Nat := Errors_Detected;
389 if Current_Verbosity = High then
390 Write_Str ("Opening """);
397 Prj.Util.Open (File, Path);
399 if not Prj.Util.Is_Valid (File) then
400 Error_Msg ("file does not exist", Location);
402 while not Prj.Util.End_Of_File (File) loop
403 Prj.Util.Get_Line (File, Line, Last);
405 -- If the line is not empty and does not start with "--",
406 -- then it must contains a file name.
409 and then (Last = 1 or else Line (1 .. 2) /= "--")
411 Get_Path_Name_And_Record_Source
412 (File_Name => Line (1 .. Last),
413 Location => Location,
414 Current_Source => Current_Source);
415 exit when Nmb_Errors /= Errors_Detected;
419 Prj.Util.Close (File);
423 -- We should have found at least one source.
424 -- If not, report an error.
426 if Current_Source = Nil_String then
427 Error_Msg ("this project has no source", Location);
429 end Get_Sources_From_File;
431 -- Start of processing for Ada_Check
434 Language_Independent_Check (Project, Report_Error);
436 Error_Report := Report_Error;
438 Data := Projects.Table (Project);
439 Languages := Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes);
441 Data.Naming.Current_Language := Name_Ada;
442 Data.Sources_Present := Data.Source_Dirs /= Nil_String;
444 if not Languages.Default then
446 Current : String_List_Id := Languages.Values;
447 Element : String_Element;
448 Ada_Found : Boolean := False;
451 Look_For_Ada : while Current /= Nil_String loop
452 Element := String_Elements.Table (Current);
453 String_To_Name_Buffer (Element.Value);
454 To_Lower (Name_Buffer (1 .. Name_Len));
456 if Name_Buffer (1 .. Name_Len) = "ada" then
461 Current := Element.Next;
462 end loop Look_For_Ada;
464 if not Ada_Found then
466 -- Mark the project file as having no sources for Ada
468 Data.Sources_Present := False;
474 Naming_Id : constant Package_Id :=
475 Util.Value_Of (Name_Naming, Data.Decl.Packages);
477 Naming : Package_Element;
480 -- If there is a package Naming, we will put in Data.Naming
481 -- what is in this package Naming.
483 if Naming_Id /= No_Package then
484 Naming := Packages.Table (Naming_Id);
486 if Current_Verbosity = High then
487 Write_Line ("Checking ""Naming"" for Ada.");
491 Bodies : constant Array_Element_Id :=
493 (Name_Implementation, Naming.Decl.Arrays);
495 Specifications : constant Array_Element_Id :=
497 (Name_Specification, Naming.Decl.Arrays);
500 if Bodies /= No_Array_Element then
502 -- We have elements in the array Body_Part
504 if Current_Verbosity = High then
505 Write_Line ("Found Bodies.");
508 Data.Naming.Bodies := Bodies;
509 Check_Unit_Names (Bodies);
512 if Current_Verbosity = High then
513 Write_Line ("No Bodies.");
517 if Specifications /= No_Array_Element then
519 -- We have elements in the array Specification
521 if Current_Verbosity = High then
522 Write_Line ("Found Specifications.");
525 Data.Naming.Specifications := Specifications;
526 Check_Unit_Names (Specifications);
529 if Current_Verbosity = High then
530 Write_Line ("No Specifications.");
535 -- We are now checking if variables Dot_Replacement, Casing,
536 -- Specification_Append, Body_Append and/or Separate_Append
539 -- For each variable, if it does not exist, we do nothing,
540 -- because we already have the default.
542 -- Check Dot_Replacement
545 Dot_Replacement : constant Variable_Value :=
547 (Name_Dot_Replacement,
548 Naming.Decl.Attributes);
551 pragma Assert (Dot_Replacement.Kind = Single,
552 "Dot_Replacement is not a single string");
554 if not Dot_Replacement.Default then
556 String_To_Name_Buffer (Dot_Replacement.Value);
559 Error_Msg ("Dot_Replacement cannot be empty",
560 Dot_Replacement.Location);
563 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
564 Data.Naming.Dot_Replacement := Name_Find;
565 Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
572 if Current_Verbosity = High then
573 Write_Str (" Dot_Replacement = """);
574 Write_Str (Get_Name_String (Data.Naming.Dot_Replacement));
582 Casing_String : constant Variable_Value :=
583 Util.Value_Of (Name_Casing, Naming.Decl.Attributes);
586 pragma Assert (Casing_String.Kind = Single,
587 "Casing is not a single string");
589 if not Casing_String.Default then
591 Casing_Image : constant String :=
592 Get_Name_String (Casing_String.Value);
596 Casing : constant Casing_Type :=
597 Value (Casing_Image);
600 Data.Naming.Casing := Casing;
604 when Constraint_Error =>
605 if Casing_Image'Length = 0 then
606 Error_Msg ("Casing cannot be an empty string",
607 Casing_String.Location);
610 Name_Len := Casing_Image'Length;
611 Name_Buffer (1 .. Name_Len) := Casing_Image;
612 Error_Msg_Name_1 := Name_Find;
614 ("{ is not a correct Casing",
615 Casing_String.Location);
621 if Current_Verbosity = High then
622 Write_Str (" Casing = ");
623 Write_Str (Image (Data.Naming.Casing));
628 -- Check Specification_Suffix
631 Ada_Spec_Suffix : constant Variable_Value :=
634 In_Array => Data.Naming.Specification_Suffix);
637 if Ada_Spec_Suffix.Kind = Single
638 and then String_Length (Ada_Spec_Suffix.Value) /= 0
640 String_To_Name_Buffer (Ada_Spec_Suffix.Value);
641 Data.Naming.Current_Spec_Suffix := Name_Find;
642 Data.Naming.Spec_Suffix_Loc := Ada_Spec_Suffix.Location;
645 Data.Naming.Current_Spec_Suffix := Default_Ada_Spec_Suffix;
649 if Current_Verbosity = High then
650 Write_Str (" Specification_Suffix = """);
651 Write_Str (Get_Name_String (Data.Naming.Current_Spec_Suffix));
656 -- Check Implementation_Suffix
659 Ada_Impl_Suffix : constant Variable_Value :=
662 In_Array => Data.Naming.Implementation_Suffix);
665 if Ada_Impl_Suffix.Kind = Single
666 and then String_Length (Ada_Impl_Suffix.Value) /= 0
668 String_To_Name_Buffer (Ada_Impl_Suffix.Value);
669 Data.Naming.Current_Impl_Suffix := Name_Find;
670 Data.Naming.Impl_Suffix_Loc := Ada_Impl_Suffix.Location;
673 Data.Naming.Current_Impl_Suffix := Default_Ada_Impl_Suffix;
677 if Current_Verbosity = High then
678 Write_Str (" Implementation_Suffix = """);
679 Write_Str (Get_Name_String (Data.Naming.Current_Impl_Suffix));
684 -- Check Separate_Suffix
687 Ada_Sep_Suffix : constant Variable_Value :=
689 (Variable_Name => Name_Separate_Suffix,
690 In_Variables => Naming.Decl.Attributes);
692 if Ada_Sep_Suffix.Default then
693 Data.Naming.Separate_Suffix :=
694 Data.Naming.Current_Impl_Suffix;
697 String_To_Name_Buffer (Ada_Sep_Suffix.Value);
700 Error_Msg ("Separate_Suffix cannot be empty",
701 Ada_Sep_Suffix.Location);
704 Data.Naming.Separate_Suffix := Name_Find;
705 Data.Naming.Sep_Suffix_Loc := Ada_Sep_Suffix.Location;
712 if Current_Verbosity = High then
713 Write_Str (" Separate_Suffix = """);
714 Write_Str (Get_Name_String (Data.Naming.Separate_Suffix));
719 -- Check if Data.Naming is valid
721 Check_Ada_Naming_Scheme (Data.Naming);
724 Data.Naming.Current_Spec_Suffix := Default_Ada_Spec_Suffix;
725 Data.Naming.Current_Impl_Suffix := Default_Ada_Impl_Suffix;
726 Data.Naming.Separate_Suffix := Default_Ada_Impl_Suffix;
730 -- If we have source directories, then find the sources
732 if Data.Sources_Present then
733 if Data.Source_Dirs = Nil_String then
734 Data.Sources_Present := False;
738 Sources : constant Variable_Value :=
741 Data.Decl.Attributes);
743 Source_List_File : constant Variable_Value :=
745 (Name_Source_List_File,
746 Data.Decl.Attributes);
750 (Sources.Kind = List,
751 "Source_Files is not a list");
753 (Source_List_File.Kind = Single,
754 "Source_List_File is not a single string");
756 if not Sources.Default then
757 if not Source_List_File.Default then
759 ("?both variables source_files and " &
760 "source_list_file are present",
761 Source_List_File.Location);
764 -- Sources is a list of file names
767 Current_Source : String_List_Id := Nil_String;
768 Current : String_List_Id := Sources.Values;
769 Element : String_Element;
772 Data.Sources_Present := Current /= Nil_String;
774 while Current /= Nil_String loop
775 Element := String_Elements.Table (Current);
776 String_To_Name_Buffer (Element.Value);
779 File_Name : constant String :=
780 Name_Buffer (1 .. Name_Len);
783 Get_Path_Name_And_Record_Source
784 (File_Name => File_Name,
785 Location => Element.Location,
786 Current_Source => Current_Source);
787 Current := Element.Next;
792 -- No source_files specified.
793 -- We check Source_List_File has been specified.
795 elsif not Source_List_File.Default then
797 -- Source_List_File is the name of the file
798 -- that contains the source file names
801 Source_File_Path_Name : constant String :=
803 (Source_List_File.Value,
807 if Source_File_Path_Name'Length = 0 then
808 String_To_Name_Buffer (Source_List_File.Value);
809 Error_Msg_Name_1 := Name_Find;
811 ("file with sources { does not exist",
812 Source_List_File.Location);
815 Get_Sources_From_File
816 (Source_File_Path_Name,
817 Source_List_File.Location);
822 -- Neither Source_Files nor Source_List_File has been
824 -- Find all the files that satisfy
825 -- the naming scheme in all the source directories.
833 Projects.Table (Project) := Data;
840 procedure Check_Ada_Name
844 The_Name : String := Get_Name_String (Name);
845 Need_Letter : Boolean := True;
846 Last_Underscore : Boolean := False;
847 OK : Boolean := The_Name'Length > 0;
850 for Index in The_Name'Range loop
853 -- We need a letter (at the beginning, and following a dot),
854 -- but we don't have one.
856 if Is_Letter (The_Name (Index)) then
857 Need_Letter := False;
862 if Current_Verbosity = High then
863 Write_Int (Types.Int (Index));
865 Write_Char (The_Name (Index));
866 Write_Line ("' is not a letter.");
872 elsif Last_Underscore
873 and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
875 -- Two underscores are illegal, and a dot cannot follow
880 if Current_Verbosity = High then
881 Write_Int (Types.Int (Index));
883 Write_Char (The_Name (Index));
884 Write_Line ("' is illegal here.");
889 elsif The_Name (Index) = '.' then
891 -- We need a letter after a dot
895 elsif The_Name (Index) = '_' then
896 Last_Underscore := True;
899 -- We need an letter or a digit
901 Last_Underscore := False;
903 if not Is_Alphanumeric (The_Name (Index)) then
906 if Current_Verbosity = High then
907 Write_Int (Types.Int (Index));
909 Write_Char (The_Name (Index));
910 Write_Line ("' is not alphanumeric.");
918 -- Cannot end with an underscore or a dot
920 OK := OK and then not Need_Letter and then not Last_Underscore;
925 -- Signal a problem with No_Name
931 -----------------------------
932 -- Check_Ada_Naming_Scheme --
933 -----------------------------
935 procedure Check_Ada_Naming_Scheme (Naming : Naming_Data) is
937 -- Only check if we are not using the standard naming scheme
939 if Naming /= Standard_Naming_Data then
941 Dot_Replacement : constant String :=
943 (Naming.Dot_Replacement);
945 Specification_Suffix : constant String :=
947 (Naming.Current_Spec_Suffix);
949 Implementation_Suffix : constant String :=
951 (Naming.Current_Impl_Suffix);
953 Separate_Suffix : constant String :=
955 (Naming.Separate_Suffix);
958 -- Dot_Replacement cannot
960 -- - start or end with an alphanumeric
962 -- - start with an '_' followed by an alphanumeric
963 -- - contain a '.' except if it is "."
965 if Dot_Replacement'Length = 0
966 or else Is_Alphanumeric
967 (Dot_Replacement (Dot_Replacement'First))
968 or else Is_Alphanumeric
969 (Dot_Replacement (Dot_Replacement'Last))
970 or else (Dot_Replacement (Dot_Replacement'First) = '_'
972 (Dot_Replacement'Length = 1
975 (Dot_Replacement (Dot_Replacement'First + 1))))
976 or else (Dot_Replacement'Length > 1
978 Index (Source => Dot_Replacement,
979 Pattern => ".") /= 0)
982 ('"' & Dot_Replacement &
983 """ is illegal for Dot_Replacement.",
984 Naming.Dot_Repl_Loc);
989 -- - start with an alphanumeric
990 -- - start with an '_' followed by an alphanumeric
992 if Is_Illegal_Append (Specification_Suffix) then
993 Error_Msg_Name_1 := Naming.Current_Spec_Suffix;
995 ("{ is illegal for Specification_Suffix",
996 Naming.Spec_Suffix_Loc);
999 if Is_Illegal_Append (Implementation_Suffix) then
1000 Error_Msg_Name_1 := Naming.Current_Impl_Suffix;
1002 ("% is illegal for Implementation_Suffix",
1003 Naming.Impl_Suffix_Loc);
1006 if Implementation_Suffix /= Separate_Suffix then
1007 if Is_Illegal_Append (Separate_Suffix) then
1008 Error_Msg_Name_1 := Naming.Separate_Suffix;
1010 ("{ is illegal for Separate_Append",
1011 Naming.Sep_Suffix_Loc);
1015 -- Specification_Suffix cannot have the same termination as
1016 -- Implementation_Suffix or Separate_Suffix
1018 if Specification_Suffix'Length <= Implementation_Suffix'Length
1020 Implementation_Suffix (Implementation_Suffix'Last -
1021 Specification_Suffix'Length + 1 ..
1022 Implementation_Suffix'Last) = Specification_Suffix
1025 ("Implementation_Suffix (""" &
1026 Implementation_Suffix &
1027 """) cannot end with" &
1028 "Specification_Suffix (""" &
1029 Specification_Suffix & """).",
1030 Naming.Impl_Suffix_Loc);
1033 if Specification_Suffix'Length <= Separate_Suffix'Length
1036 (Separate_Suffix'Last - Specification_Suffix'Length + 1
1038 Separate_Suffix'Last) = Specification_Suffix
1041 ("Separate_Suffix (""" &
1043 """) cannot end with" &
1044 " Specification_Suffix (""" &
1045 Specification_Suffix & """).",
1046 Naming.Sep_Suffix_Loc);
1051 end Check_Ada_Naming_Scheme;
1057 procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
1059 Error_Buffer : String (1 .. 5_000);
1060 Error_Last : Natural := 0;
1061 Msg_Name : Natural := 0;
1062 First : Positive := Msg'First;
1064 procedure Add (C : Character);
1065 -- Add a character to the buffer
1067 procedure Add (S : String);
1068 -- Add a string to the buffer
1070 procedure Add (Id : Name_Id);
1071 -- Add a name to the buffer
1077 procedure Add (C : Character) is
1079 Error_Last := Error_Last + 1;
1080 Error_Buffer (Error_Last) := C;
1083 procedure Add (S : String) is
1085 Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
1086 Error_Last := Error_Last + S'Length;
1089 procedure Add (Id : Name_Id) is
1091 Get_Name_String (Id);
1092 Add (Name_Buffer (1 .. Name_Len));
1095 -- Start of processing for Error_Msg
1098 if Error_Report = null then
1099 Errout.Error_Msg (Msg, Flag_Location);
1103 if Msg (First) = '\' then
1105 -- Continuation character, ignore.
1109 elsif Msg (First) = '?' then
1111 -- Warning character. It is always the first one,
1118 for Index in First .. Msg'Last loop
1119 if Msg (Index) = '{' or else Msg (Index) = '%' then
1121 -- Include a name between double quotes.
1123 Msg_Name := Msg_Name + 1;
1127 when 1 => Add (Error_Msg_Name_1);
1129 when 2 => Add (Error_Msg_Name_2);
1131 when 3 => Add (Error_Msg_Name_3);
1133 when others => null;
1144 Error_Report (Error_Buffer (1 .. Error_Last));
1147 ---------------------
1148 -- Get_Name_String --
1149 ---------------------
1151 function Get_Name_String (S : String_Id) return String is
1153 if S = No_String then
1156 String_To_Name_Buffer (S);
1157 return Name_Buffer (1 .. Name_Len);
1159 end Get_Name_String;
1166 (File_Name : Name_Id;
1167 Naming : Naming_Data;
1168 Unit_Name : out Name_Id;
1169 Unit_Kind : out Spec_Or_Body;
1170 Needs_Pragma : out Boolean)
1172 Canonical_Case_Name : Name_Id;
1175 Needs_Pragma := False;
1176 Get_Name_String (File_Name);
1177 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1178 Canonical_Case_Name := Name_Find;
1180 if Naming.Bodies /= No_Array_Element then
1182 -- There are some specified file names for some bodies
1183 -- of this project. Find out if File_Name is one of these bodies.
1186 Current : Array_Element_Id := Naming.Bodies;
1187 Element : Array_Element;
1190 while Current /= No_Array_Element loop
1191 Element := Array_Elements.Table (Current);
1193 if Element.Index /= No_Name then
1194 String_To_Name_Buffer (Element.Value.Value);
1195 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1197 if Canonical_Case_Name = Name_Find then
1199 -- File_Name corresponds to one body.
1200 -- So, we know it is a body, and we know the unit name.
1202 Unit_Kind := Body_Part;
1203 Unit_Name := Element.Index;
1204 Needs_Pragma := True;
1209 Current := Element.Next;
1214 if Naming.Specifications /= No_Array_Element then
1216 -- There are some specified file names for some bodiesspecifications
1217 -- of this project. Find out if File_Name is one of these
1221 Current : Array_Element_Id := Naming.Specifications;
1222 Element : Array_Element;
1225 while Current /= No_Array_Element loop
1226 Element := Array_Elements.Table (Current);
1228 if Element.Index /= No_Name then
1229 String_To_Name_Buffer (Element.Value.Value);
1230 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1232 if Canonical_Case_Name = Name_Find then
1234 -- File_Name corresponds to one specification.
1235 -- So, we know it is a spec, and we know the unit name.
1237 Unit_Kind := Specification;
1238 Unit_Name := Element.Index;
1239 Needs_Pragma := True;
1245 Current := Element.Next;
1251 File : String := Get_Name_String (Canonical_Case_Name);
1252 First : Positive := File'First;
1253 Last : Natural := File'Last;
1256 -- Check if the end of the file name is Specification_Append
1258 Get_Name_String (Naming.Current_Spec_Suffix);
1260 if File'Length > Name_Len
1261 and then File (Last - Name_Len + 1 .. Last) =
1262 Name_Buffer (1 .. Name_Len)
1266 Unit_Kind := Specification;
1267 Last := Last - Name_Len;
1269 if Current_Verbosity = High then
1270 Write_Str (" Specification: ");
1271 Write_Line (File (First .. Last));
1275 Get_Name_String (Naming.Current_Impl_Suffix);
1277 -- Check if the end of the file name is Body_Append
1279 if File'Length > Name_Len
1280 and then File (Last - Name_Len + 1 .. Last) =
1281 Name_Buffer (1 .. Name_Len)
1285 Unit_Kind := Body_Part;
1286 Last := Last - Name_Len;
1288 if Current_Verbosity = High then
1289 Write_Str (" Body: ");
1290 Write_Line (File (First .. Last));
1293 elsif Naming.Separate_Suffix /= Naming.Current_Spec_Suffix then
1294 Get_Name_String (Naming.Separate_Suffix);
1296 -- Check if the end of the file name is Separate_Append
1298 if File'Length > Name_Len
1299 and then File (Last - Name_Len + 1 .. Last) =
1300 Name_Buffer (1 .. Name_Len)
1302 -- We have a separate (a body)
1304 Unit_Kind := Body_Part;
1305 Last := Last - Name_Len;
1307 if Current_Verbosity = High then
1308 Write_Str (" Separate: ");
1309 Write_Line (File (First .. Last));
1323 -- This is not a source file
1325 Unit_Name := No_Name;
1326 Unit_Kind := Specification;
1328 if Current_Verbosity = High then
1329 Write_Line (" Not a valid file name.");
1335 Get_Name_String (Naming.Dot_Replacement);
1337 if Name_Buffer (1 .. Name_Len) /= "." then
1339 -- If Dot_Replacement is not a single dot,
1340 -- then there should not be any dot in the name.
1342 for Index in First .. Last loop
1343 if File (Index) = '.' then
1344 if Current_Verbosity = High then
1346 (" Not a valid file name (some dot not replaced).");
1349 Unit_Name := No_Name;
1355 -- Replace the substring Dot_Replacement with dots
1358 Index : Positive := First;
1361 while Index <= Last - Name_Len + 1 loop
1363 if File (Index .. Index + Name_Len - 1) =
1364 Name_Buffer (1 .. Name_Len)
1366 File (Index) := '.';
1368 if Name_Len > 1 and then Index < Last then
1369 File (Index + 1 .. Last - Name_Len + 1) :=
1370 File (Index + Name_Len .. Last);
1373 Last := Last - Name_Len + 1;
1381 -- Check if the casing is right
1384 Src : String := File (First .. Last);
1387 case Naming.Casing is
1388 when All_Lower_Case =>
1391 Mapping => Lower_Case_Map);
1393 when All_Upper_Case =>
1396 Mapping => Upper_Case_Map);
1398 when Mixed_Case | Unknown =>
1402 if Src /= File (First .. Last) then
1403 if Current_Verbosity = High then
1404 Write_Line (" Not a valid file name (casing).");
1407 Unit_Name := No_Name;
1411 -- We put the name in lower case
1415 Mapping => Lower_Case_Map);
1417 if Current_Verbosity = High then
1422 Name_Len := Src'Length;
1423 Name_Buffer (1 .. Name_Len) := Src;
1425 -- Now, we check if this name is a valid unit name
1427 Check_Ada_Name (Name => Name_Find, Unit => Unit_Name);
1434 -----------------------
1435 -- Is_Illegal_Append --
1436 -----------------------
1438 function Is_Illegal_Append (This : String) return Boolean is
1440 return This'Length = 0
1441 or else Is_Alphanumeric (This (This'First))
1442 or else Index (This, ".") = 0
1443 or else (This'Length >= 2
1444 and then This (This'First) = '_'
1445 and then Is_Alphanumeric (This (This'First + 1)));
1446 end Is_Illegal_Append;
1448 --------------------------------
1449 -- Language_Independent_Check --
1450 --------------------------------
1452 procedure Language_Independent_Check
1453 (Project : Project_Id;
1454 Report_Error : Put_Line_Access)
1456 Last_Source_Dir : String_List_Id := Nil_String;
1457 Data : Project_Data := Projects.Table (Project);
1459 procedure Find_Source_Dirs (From : String_Id; Location : Source_Ptr);
1460 -- Find one or several source directories, and add them
1461 -- to the list of source directories of the project.
1463 ----------------------
1464 -- Find_Source_Dirs --
1465 ----------------------
1467 procedure Find_Source_Dirs (From : String_Id; Location : Source_Ptr) is
1469 Directory : String (1 .. Integer (String_Length (From)));
1470 Directory_Id : Name_Id;
1471 Element : String_Element;
1473 procedure Recursive_Find_Dirs (Path : String_Id);
1474 -- Find all the subdirectories (recursively) of Path
1475 -- and add them to the list of source directories
1478 -------------------------
1479 -- Recursive_Find_Dirs --
1480 -------------------------
1482 procedure Recursive_Find_Dirs (Path : String_Id) is
1484 Name : String (1 .. 250);
1486 The_Path : String := Get_Name_String (Path) & Dir_Sep;
1488 The_Path_Last : Positive := The_Path'Last;
1491 if The_Path'Length > 1
1493 (The_Path (The_Path_Last - 1) = Dir_Sep
1494 or else The_Path (The_Path_Last - 1) = '/')
1496 The_Path_Last := The_Path_Last - 1;
1499 if Current_Verbosity = High then
1501 Write_Line (The_Path (The_Path'First .. The_Path_Last));
1504 String_Elements.Increment_Last;
1507 Location => No_Location,
1508 Next => Nil_String);
1510 -- Case of first source directory
1512 if Last_Source_Dir = Nil_String then
1513 Data.Source_Dirs := String_Elements.Last;
1515 -- Here we already have source directories.
1518 -- Link the previous last to the new one
1520 String_Elements.Table (Last_Source_Dir).Next :=
1521 String_Elements.Last;
1524 -- And register this source directory as the new last
1526 Last_Source_Dir := String_Elements.Last;
1527 String_Elements.Table (Last_Source_Dir) := Element;
1529 -- Now look for subdirectories
1531 Open (Dir, The_Path (The_Path'First .. The_Path_Last));
1534 Read (Dir, Name, Last);
1537 if Current_Verbosity = High then
1538 Write_Str (" Checking ");
1539 Write_Line (Name (1 .. Last));
1542 if Name (1 .. Last) /= "."
1543 and then Name (1 .. Last) /= ".."
1548 Path_Name : constant String :=
1549 The_Path (The_Path'First .. The_Path_Last) &
1553 if Is_Directory (Path_Name) then
1555 -- We have found a new subdirectory,
1556 -- register it and find its own subdirectories.
1559 Store_String_Chars (Path_Name);
1560 Recursive_Find_Dirs (End_String);
1569 when Directory_Error =>
1571 end Recursive_Find_Dirs;
1573 -- Start of processing for Find_Source_Dirs
1576 if Current_Verbosity = High then
1577 Write_Str ("Find_Source_Dirs (""");
1580 String_To_Name_Buffer (From);
1581 Directory := Name_Buffer (1 .. Name_Len);
1582 Directory_Id := Name_Find;
1584 if Current_Verbosity = High then
1585 Write_Str (Directory);
1589 -- First, check if we are looking for a directory tree,
1590 -- indicated by "/**" at the end.
1592 if Directory'Length >= 3
1593 and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
1594 and then (Directory (Directory'Last - 2) = '/'
1596 Directory (Directory'Last - 2) = Dir_Sep)
1598 Name_Len := Directory'Length - 3;
1600 if Name_Len = 0 then
1601 -- This is the case of "/**": all directories
1602 -- in the file system.
1605 Name_Buffer (1) := Directory (Directory'First);
1608 Name_Buffer (1 .. Name_Len) :=
1609 Directory (Directory'First .. Directory'Last - 3);
1612 if Current_Verbosity = High then
1613 Write_Str ("Looking for all subdirectories of """);
1614 Write_Str (Name_Buffer (1 .. Name_Len));
1619 Base_Dir : constant Name_Id := Name_Find;
1620 Root : constant Name_Id :=
1621 Locate_Directory (Base_Dir, Data.Directory);
1624 if Root = No_Name then
1625 Error_Msg_Name_1 := Base_Dir;
1626 if Location = No_Location then
1627 Error_Msg ("{ is not a valid directory.", Data.Location);
1629 Error_Msg ("{ is not a valid directory.", Location);
1633 -- We have an existing directory,
1634 -- we register it and all of its subdirectories.
1636 if Current_Verbosity = High then
1637 Write_Line ("Looking for source directories:");
1641 Store_String_Chars (Get_Name_String (Root));
1642 Recursive_Find_Dirs (End_String);
1644 if Current_Verbosity = High then
1645 Write_Line ("End of looking for source directories.");
1650 -- We have a single directory
1654 Path_Name : constant Name_Id :=
1655 Locate_Directory (Directory_Id, Data.Directory);
1658 if Path_Name = No_Name then
1659 Error_Msg_Name_1 := Directory_Id;
1660 if Location = No_Location then
1661 Error_Msg ("{ is not a valid directory", Data.Location);
1663 Error_Msg ("{ is not a valid directory", Location);
1667 -- As it is an existing directory, we add it to
1668 -- the list of directories.
1670 String_Elements.Increment_Last;
1672 Store_String_Chars (Get_Name_String (Path_Name));
1673 Element.Value := End_String;
1675 if Last_Source_Dir = Nil_String then
1677 -- This is the first source directory
1679 Data.Source_Dirs := String_Elements.Last;
1682 -- We already have source directories,
1683 -- link the previous last to the new one.
1685 String_Elements.Table (Last_Source_Dir).Next :=
1686 String_Elements.Last;
1689 -- And register this source directory as the new last
1691 Last_Source_Dir := String_Elements.Last;
1692 String_Elements.Table (Last_Source_Dir) := Element;
1696 end Find_Source_Dirs;
1698 -- Start of processing for Language_Independent_Check
1702 if Data.Language_Independent_Checked then
1706 Data.Language_Independent_Checked := True;
1708 Error_Report := Report_Error;
1710 if Current_Verbosity = High then
1711 Write_Line ("Starting to look for directories");
1714 -- Check the object directory
1717 Object_Dir : Variable_Value :=
1718 Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes);
1721 pragma Assert (Object_Dir.Kind = Single,
1722 "Object_Dir is not a single string");
1724 -- We set the object directory to its default
1726 Data.Object_Directory := Data.Directory;
1728 if not String_Equal (Object_Dir.Value, Empty_String) then
1730 String_To_Name_Buffer (Object_Dir.Value);
1732 if Name_Len = 0 then
1733 Error_Msg ("Object_Dir cannot be empty",
1734 Object_Dir.Location);
1737 -- We check that the specified object directory
1740 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1743 Dir_Id : constant Name_Id := Name_Find;
1746 Data.Object_Directory :=
1747 Locate_Directory (Dir_Id, Data.Directory);
1749 if Data.Object_Directory = No_Name then
1750 Error_Msg_Name_1 := Dir_Id;
1752 ("the object directory { cannot be found",
1760 if Current_Verbosity = High then
1761 if Data.Object_Directory = No_Name then
1762 Write_Line ("No object directory");
1764 Write_Str ("Object directory: """);
1765 Write_Str (Get_Name_String (Data.Object_Directory));
1770 -- Check the exec directory
1773 Exec_Dir : Variable_Value :=
1774 Util.Value_Of (Name_Exec_Dir, Data.Decl.Attributes);
1777 pragma Assert (Exec_Dir.Kind = Single,
1778 "Exec_Dir is not a single string");
1780 -- We set the object directory to its default
1782 Data.Exec_Directory := Data.Object_Directory;
1784 if not String_Equal (Exec_Dir.Value, Empty_String) then
1786 String_To_Name_Buffer (Exec_Dir.Value);
1788 if Name_Len = 0 then
1789 Error_Msg ("Exec_Dir cannot be empty",
1793 -- We check that the specified object directory
1796 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1799 Dir_Id : constant Name_Id := Name_Find;
1802 Data.Exec_Directory :=
1803 Locate_Directory (Dir_Id, Data.Directory);
1805 if Data.Exec_Directory = No_Name then
1806 Error_Msg_Name_1 := Dir_Id;
1808 ("the exec directory { cannot be found",
1816 if Current_Verbosity = High then
1817 if Data.Exec_Directory = No_Name then
1818 Write_Line ("No exec directory");
1820 Write_Str ("Exec directory: """);
1821 Write_Str (Get_Name_String (Data.Exec_Directory));
1826 -- Look for the source directories
1829 Source_Dirs : Variable_Value :=
1830 Util.Value_Of (Name_Source_Dirs, Data.Decl.Attributes);
1834 if Current_Verbosity = High then
1835 Write_Line ("Starting to look for source directories");
1838 pragma Assert (Source_Dirs.Kind = List,
1839 "Source_Dirs is not a list");
1841 if Source_Dirs.Default then
1843 -- No Source_Dirs specified: the single source directory
1844 -- is the one containing the project file
1846 String_Elements.Increment_Last;
1847 Data.Source_Dirs := String_Elements.Last;
1849 Store_String_Chars (Get_Name_String (Data.Directory));
1850 String_Elements.Table (Data.Source_Dirs) :=
1851 (Value => End_String,
1852 Location => No_Location,
1853 Next => Nil_String);
1855 if Current_Verbosity = High then
1856 Write_Line ("(Undefined) Single object directory:");
1858 Write_Str (Get_Name_String (Data.Directory));
1862 elsif Source_Dirs.Values = Nil_String then
1864 -- If Source_Dirs is an empty string list, this means
1865 -- that this project contains no source.
1867 if Data.Object_Directory = Data.Directory then
1868 Data.Object_Directory := No_Name;
1871 Data.Source_Dirs := Nil_String;
1872 Data.Sources_Present := False;
1876 Source_Dir : String_List_Id := Source_Dirs.Values;
1877 Element : String_Element;
1880 -- We will find the source directories for each
1881 -- element of the list
1883 while Source_Dir /= Nil_String loop
1884 Element := String_Elements.Table (Source_Dir);
1885 Find_Source_Dirs (Element.Value, Element.Location);
1886 Source_Dir := Element.Next;
1891 if Current_Verbosity = High then
1892 Write_Line ("Puting source directories in canonical cases");
1896 Current : String_List_Id := Data.Source_Dirs;
1897 Element : String_Element;
1900 while Current /= Nil_String loop
1901 Element := String_Elements.Table (Current);
1902 if Element.Value /= No_String then
1903 String_To_Name_Buffer (Element.Value);
1904 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1906 Store_String_Chars (Name_Buffer (1 .. Name_Len));
1907 Element.Value := End_String;
1908 String_Elements.Table (Current) := Element;
1911 Current := Element.Next;
1916 -- Library Dir, Name, Version and Kind
1919 Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
1921 Lib_Dir : Prj.Variable_Value :=
1922 Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes);
1924 Lib_Name : Prj.Variable_Value :=
1925 Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes);
1927 Lib_Version : Prj.Variable_Value :=
1929 (Snames.Name_Library_Version, Attributes);
1931 The_Lib_Kind : Prj.Variable_Value :=
1933 (Snames.Name_Library_Kind, Attributes);
1936 pragma Assert (Lib_Dir.Kind = Single);
1938 if Lib_Dir.Value = Empty_String then
1940 if Current_Verbosity = High then
1941 Write_Line ("No library directory");
1945 -- Find path name, check that it is a directory
1947 Stringt.String_To_Name_Buffer (Lib_Dir.Value);
1950 Dir_Id : constant Name_Id := Name_Find;
1954 Locate_Directory (Dir_Id, Data.Directory);
1956 if Data.Library_Dir = No_Name then
1957 Error_Msg ("not an existing directory",
1960 elsif Data.Library_Dir = Data.Object_Directory then
1962 ("library directory cannot be the same " &
1963 "as object directory",
1965 Data.Library_Dir := No_Name;
1968 if Current_Verbosity = High then
1969 Write_Str ("Library directory =""");
1970 Write_Str (Get_Name_String (Data.Library_Dir));
1977 pragma Assert (Lib_Name.Kind = Single);
1979 if Lib_Name.Value = Empty_String then
1980 if Current_Verbosity = High then
1981 Write_Line ("No library name");
1985 Stringt.String_To_Name_Buffer (Lib_Name.Value);
1987 if not Is_Letter (Name_Buffer (1)) then
1988 Error_Msg ("must start with a letter",
1992 Data.Library_Name := Name_Find;
1994 for Index in 2 .. Name_Len loop
1995 if not Is_Alphanumeric (Name_Buffer (Index)) then
1996 Data.Library_Name := No_Name;
1997 Error_Msg ("only letters and digits are allowed",
2003 if Data.Library_Name /= No_Name
2004 and then Current_Verbosity = High then
2005 Write_Str ("Library name = """);
2006 Write_Str (Get_Name_String (Data.Library_Name));
2013 Data.Library_Dir /= No_Name
2015 Data.Library_Name /= No_Name;
2017 if Data.Library then
2019 if not MLib.Tgt.Libraries_Are_Supported then
2020 Error_Msg ("?libraries are not supported on this platform",
2022 Data.Library := False;
2025 if Current_Verbosity = High then
2026 Write_Line ("This is a library project file");
2029 pragma Assert (Lib_Version.Kind = Single);
2031 if Lib_Version.Value = Empty_String then
2032 if Current_Verbosity = High then
2033 Write_Line ("No library version specified");
2037 Stringt.String_To_Name_Buffer (Lib_Version.Value);
2038 Data.Lib_Internal_Name := Name_Find;
2041 pragma Assert (The_Lib_Kind.Kind = Single);
2043 if The_Lib_Kind.Value = Empty_String then
2044 if Current_Verbosity = High then
2045 Write_Line ("No library kind specified");
2049 Stringt.String_To_Name_Buffer (The_Lib_Kind.Value);
2052 Kind_Name : constant String :=
2053 To_Lower (Name_Buffer (1 .. Name_Len));
2055 OK : Boolean := True;
2058 if Kind_Name = "static" then
2059 Data.Library_Kind := Static;
2061 elsif Kind_Name = "dynamic" then
2062 Data.Library_Kind := Dynamic;
2064 elsif Kind_Name = "relocatable" then
2065 Data.Library_Kind := Relocatable;
2069 ("illegal value for Library_Kind",
2070 The_Lib_Kind.Location);
2074 if Current_Verbosity = High and then OK then
2075 Write_Str ("Library kind = ");
2076 Write_Line (Kind_Name);
2084 if Current_Verbosity = High then
2085 Show_Source_Dirs (Project);
2089 Naming_Id : constant Package_Id :=
2090 Util.Value_Of (Name_Naming, Data.Decl.Packages);
2092 Naming : Package_Element;
2095 -- If there is a package Naming, we will put in Data.Naming
2096 -- what is in this package Naming.
2098 if Naming_Id /= No_Package then
2099 Naming := Packages.Table (Naming_Id);
2101 if Current_Verbosity = High then
2102 Write_Line ("Checking ""Naming"".");
2105 -- Check Specification_Suffix
2107 Data.Naming.Specification_Suffix := Util.Value_Of
2108 (Name_Specification_Suffix,
2109 Naming.Decl.Arrays);
2112 Current : Array_Element_Id := Data.Naming.Specification_Suffix;
2113 Element : Array_Element;
2116 while Current /= No_Array_Element loop
2117 Element := Array_Elements.Table (Current);
2118 String_To_Name_Buffer (Element.Value.Value);
2120 if Name_Len = 0 then
2122 ("Specification_Suffix cannot be empty",
2123 Element.Value.Location);
2126 Array_Elements.Table (Current) := Element;
2127 Current := Element.Next;
2131 -- Check Implementation_Suffix
2133 Data.Naming.Implementation_Suffix := Util.Value_Of
2134 (Name_Implementation_Suffix,
2135 Naming.Decl.Arrays);
2138 Current : Array_Element_Id := Data.Naming.Implementation_Suffix;
2139 Element : Array_Element;
2142 while Current /= No_Array_Element loop
2143 Element := Array_Elements.Table (Current);
2144 String_To_Name_Buffer (Element.Value.Value);
2146 if Name_Len = 0 then
2148 ("Implementation_Suffix cannot be empty",
2149 Element.Value.Location);
2152 Array_Elements.Table (Current) := Element;
2153 Current := Element.Next;
2160 Projects.Table (Project) := Data;
2161 end Language_Independent_Check;
2163 ----------------------
2164 -- Locate_Directory --
2165 ----------------------
2167 function Locate_Directory
2172 The_Name : constant String := Get_Name_String (Name);
2173 The_Parent : constant String :=
2174 Get_Name_String (Parent) & Dir_Sep;
2176 The_Parent_Last : Positive := The_Parent'Last;
2179 if The_Parent'Length > 1
2180 and then (The_Parent (The_Parent_Last - 1) = Dir_Sep
2181 or else The_Parent (The_Parent_Last - 1) = '/')
2183 The_Parent_Last := The_Parent_Last - 1;
2186 if Current_Verbosity = High then
2187 Write_Str ("Locate_Directory (""");
2188 Write_Str (The_Name);
2189 Write_Str (""", """);
2190 Write_Str (The_Parent);
2194 if Is_Absolute_Path (The_Name) then
2195 if Is_Directory (The_Name) then
2201 Full_Path : constant String :=
2202 The_Parent (The_Parent'First .. The_Parent_Last) &
2206 if Is_Directory (Full_Path) then
2207 Name_Len := Full_Path'Length;
2208 Name_Buffer (1 .. Name_Len) := Full_Path;
2216 end Locate_Directory;
2222 function Path_Name_Of
2223 (File_Name : String_Id;
2224 Directory : String_Id)
2227 Result : String_Access;
2230 String_To_Name_Buffer (File_Name);
2233 The_File_Name : constant String := Name_Buffer (1 .. Name_Len);
2236 String_To_Name_Buffer (Directory);
2237 Result := Locate_Regular_File
2238 (File_Name => The_File_Name,
2239 Path => Name_Buffer (1 .. Name_Len));
2242 if Result = null then
2245 Canonical_Case_File_Name (Result.all);
2250 function Path_Name_Of
2251 (File_Name : String_Id;
2252 Directory : Name_Id)
2255 Result : String_Access;
2256 The_Directory : constant String := Get_Name_String (Directory);
2259 String_To_Name_Buffer (File_Name);
2260 Result := Locate_Regular_File
2261 (File_Name => Name_Buffer (1 .. Name_Len),
2262 Path => The_Directory);
2264 if Result = null then
2267 Canonical_Case_File_Name (Result.all);
2276 procedure Record_Source
2277 (File_Name : Name_Id;
2278 Path_Name : Name_Id;
2279 Project : Project_Id;
2280 Data : in out Project_Data;
2281 Location : Source_Ptr;
2282 Current_Source : in out String_List_Id)
2284 Unit_Name : Name_Id;
2285 Unit_Kind : Spec_Or_Body;
2286 Needs_Pragma : Boolean;
2287 The_Location : Source_Ptr := Location;
2290 -- Find out the unit name, the unit kind and if it needs
2291 -- a specific SFN pragma.
2294 (File_Name => File_Name,
2295 Naming => Data.Naming,
2296 Unit_Name => Unit_Name,
2297 Unit_Kind => Unit_Kind,
2298 Needs_Pragma => Needs_Pragma);
2300 if Unit_Name = No_Name then
2301 if Current_Verbosity = High then
2303 Write_Str (Get_Name_String (File_Name));
2304 Write_Line (""" is not a valid source file name (ignored).");
2308 -- Put the file name in the list of sources of the project
2310 String_Elements.Increment_Last;
2311 Get_Name_String (File_Name);
2313 Store_String_Chars (Name_Buffer (1 .. Name_Len));
2314 String_Elements.Table (String_Elements.Last) :=
2315 (Value => End_String,
2316 Location => No_Location,
2317 Next => Nil_String);
2319 if Current_Source = Nil_String then
2320 Data.Sources := String_Elements.Last;
2323 String_Elements.Table (Current_Source).Next :=
2324 String_Elements.Last;
2327 Current_Source := String_Elements.Last;
2329 -- Put the unit in unit list
2332 The_Unit : Unit_Id := Units_Htable.Get (Unit_Name);
2333 The_Unit_Data : Unit_Data;
2336 if Current_Verbosity = High then
2337 Write_Str ("Putting ");
2338 Write_Str (Get_Name_String (Unit_Name));
2339 Write_Line (" in the unit list.");
2342 -- The unit is already in the list, but may be it is
2343 -- only the other unit kind (spec or body), or what is
2344 -- in the unit list is a unit of a project we are extending.
2346 if The_Unit /= Prj.Com.No_Unit then
2347 The_Unit_Data := Units.Table (The_Unit);
2349 if The_Unit_Data.File_Names (Unit_Kind).Name = No_Name
2350 or else (Data.Modifies /= No_Project
2352 The_Unit_Data.File_Names (Unit_Kind).Project =
2355 The_Unit_Data.File_Names (Unit_Kind) :=
2359 Needs_Pragma => Needs_Pragma);
2360 Units.Table (The_Unit) := The_Unit_Data;
2363 -- It is an error to have two units with the same name
2364 -- and the same kind (spec or body).
2366 if The_Location = No_Location then
2367 The_Location := Projects.Table (Project).Location;
2370 Error_Msg_Name_1 := Unit_Name;
2371 Error_Msg ("duplicate source {", The_Location);
2375 (The_Unit_Data.File_Names (Unit_Kind).Project).Name;
2377 The_Unit_Data.File_Names (Unit_Kind).Path;
2378 Error_Msg ("\ project file {, {", The_Location);
2380 Error_Msg_Name_1 := Projects.Table (Project).Name;
2381 Error_Msg_Name_2 := Path_Name;
2382 Error_Msg ("\ project file {, {", The_Location);
2386 -- It is a new unit, create a new record
2389 Units.Increment_Last;
2390 The_Unit := Units.Last;
2391 Units_Htable.Set (Unit_Name, The_Unit);
2392 The_Unit_Data.Name := Unit_Name;
2393 The_Unit_Data.File_Names (Unit_Kind) :=
2397 Needs_Pragma => Needs_Pragma);
2398 Units.Table (The_Unit) := The_Unit_Data;
2404 ----------------------
2405 -- Show_Source_Dirs --
2406 ----------------------
2408 procedure Show_Source_Dirs (Project : Project_Id) is
2409 Current : String_List_Id := Projects.Table (Project).Source_Dirs;
2410 Element : String_Element;
2413 Write_Line ("Source_Dirs:");
2415 while Current /= Nil_String loop
2416 Element := String_Elements.Table (Current);
2418 Write_Line (Get_Name_String (Element.Value));
2419 Current := Element.Next;
2422 Write_Line ("end Source_Dirs.");
2423 end Show_Source_Dirs;