This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Extend project file facility
- To: gcc-patches at gcc dot gnu dot org
- Subject: [Ada] Extend project file facility
- From: Geert Bosch <bosch at gnat dot com>
- Date: Wed, 10 Oct 2001 21:01:44 -0400 (EDT)
Add support for multi-language project files. Checked in for Vincent.
-Geert
2001-10-10 Vincent Celier <celier@gnat.com>
* make.adb:
(Add_Switches): reflect the changes for the switches attributes
Default_Switches indexed by the programming language,
Switches indexed by the file name.
(Collect_Arguments_And_Compile): Idem.
Reflect the attribute name changes.
* prj-attr.adb:
(Initialisation_Data): Change the names of some packages and
attributes.
(Initialize): process case insensitive associative arrays.
* prj-attr.ads:
(Attribute_Kind): Remove Both, add Case_Insensitive_Associative_Array.
* prj-dect.adb:
(Parse_Attribute_Declaration): For case insensitive associative
arrays, set the index string to lower case.
* prj-env.adb:
Reflect the changes of the project attributes.
* prj-nmsc.adb:
Replace Check_Naming_Scheme by Ada_Check and
Language_Independent_Check.
* prj-nmsc.ads:
Replaced Check_Naming_Scheme by 2 procedures:
Ada_Check and Language_Independent_Check.
* prj-proc.adb:
(Process_Declarative_Items): For case-insensitive associative
arrays, set the index string to lower case.
(Recursive_Check): Call Prj.Nmsc.Ada_Check, instead of
Prj.Nmsc.Check_Naming_Scheme.
* prj-tree.adb:
(Case_Insensitive): New function
(Set_Case_Insensitive): New procedure
* prj-tree.ads:
(Case_Insensitive): New function
(Set_Case_Insensitive): New procedure
(Project_Node_Record): New flag Case_Insensitive.
* prj-util.adb:
(Value_Of): new function to get the string value of a single
string variable or attribute.
* prj-util.ads:
(Value_Of): new function to get the string value of a single
string variable or attribute.
* prj.adb:
(Ada_Default_Spec_Suffix): New function
(Ada_Default_Impl_Suffix): New function
Change definitions of several constants to reflect
new components of record types.
* prj.ads:
(Naming_Data): Change several components to reflect new
elements of naming schemes.
(Project_Data): New flags Sources_Present and
Language_Independent_Checked.
(Ada_Default_Spec_Suffix): New function.
(Ada_Default_Impl_Suffix): New function.
* snames.ads:
Modification of predefined names for project manager: added
Implementation, Specification_Exceptions, Implementation_Exceptions,
Specification_Suffix, Implementation_Suffix, Separate_Suffix,
Default_Switches, _Languages, Builder, Cross_Reference,
Finder. Removed Body_Part, Specification_Append, Body_Append,
Separate_Append, Gnatmake, Gnatxref, Gnatfind, Gnatbind,
Gnatlink.
* prj.ads: (Ada_Default_Spec_Suffix, Ada_Default_Impl_Suffix):
Add comments.
* prj-nmsc.adb (Ada_Check): Test that Separate_Suffix is defaulted,
not that it is Nil_Variable_Value.
* prj.ads: Add ??? for uncommented declarations
*** make.adb 2001/09/25 03:13:09 1.173
--- make.adb 2001/10/05 15:15:13 1.174
***************
*** 623,637 ****
Switch_List : String_List_Id;
Element : String_Element;
begin
if File_Name'Length > 0 then
Name_Len := File_Name'Length;
Name_Buffer (1 .. Name_Len) := File_Name;
Switches :=
! Prj.Util.Value_Of
! (Name => Name_Find,
! Attribute_Or_Array_Name => Name_Switches,
! In_Package => The_Package);
case Switches.Kind is
when Undefined =>
--- 623,649 ----
Switch_List : String_List_Id;
Element : String_Element;
+ Switches_Array : constant Array_Element_Id :=
+ Prj.Util.Value_Of
+ (Name => Name_Switches,
+ In_Arrays => Packages.Table (The_Package).Decl.Arrays);
+ Default_Switches_Array : constant Array_Element_Id :=
+ Prj.Util.Value_Of
+ (Name => Name_Default_Switches,
+ In_Arrays => Packages.Table (The_Package).Decl.Arrays);
+
begin
if File_Name'Length > 0 then
Name_Len := File_Name'Length;
Name_Buffer (1 .. Name_Len) := File_Name;
Switches :=
! Prj.Util.Value_Of (Index => Name_Find, In_Array => Switches_Array);
!
! if Switches = Nil_Variable_Value then
! Switches := Prj.Util.Value_Of
! (Index => Name_Ada,
! In_Array => Default_Switches_Array);
! end if;
case Switches.Kind is
when Undefined =>
***************
*** 1659,1670 ****
-- If package Gnatmake.Compiler exists, we get
-- the specific switches for the current source,
-- or the global switches, if any.
- Switches :=
- Prj.Util.Value_Of
- (Name => Source_File,
- Attribute_Or_Array_Name => Name_Switches,
- In_Package => Compiler_Package);
end if;
case Switches.Kind is
--- 1671,1703 ----
-- If package Gnatmake.Compiler exists, we get
-- the specific switches for the current source,
-- or the global switches, if any.
+
+ declare
+ Defaults : constant Array_Element_Id :=
+ Prj.Util.Value_Of
+ (Name => Name_Default_Switches,
+ In_Arrays => Packages.Table
+ (Compiler_Package).Decl.Arrays);
+ Switches_Array : constant Array_Element_Id :=
+ Prj.Util.Value_Of
+ (Name => Name_Switches,
+ In_Arrays => Packages.Table
+ (Compiler_Package).Decl.Arrays);
+
+ begin
+ Switches :=
+ Prj.Util.Value_Of
+ (Index => Source_File,
+ In_Array => Switches_Array);
+
+ if Switches = Nil_Variable_Value then
+ Switches :=
+ Prj.Util.Value_Of
+ (Index => Name_Ada, In_Array => Defaults);
+ end if;
+
+ end;
end if;
case Switches.Kind is
***************
*** 2609,2625 ****
Gnatmake : constant Prj.Package_Id :=
Prj.Util.Value_Of
! (Name => Name_Gnatmake,
In_Packages => The_Packages);
Binder_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
! (Name => Name_Gnatbind,
In_Packages => The_Packages);
Linker_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
! (Name => Name_Gnatlink,
In_Packages => The_Packages);
begin
--- 2642,2658 ----
Gnatmake : constant Prj.Package_Id :=
Prj.Util.Value_Of
! (Name => Name_Builder,
In_Packages => The_Packages);
Binder_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
! (Name => Name_Binder,
In_Packages => The_Packages);
Linker_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
! (Name => Name_Linker,
In_Packages => The_Packages);
begin
***************
*** 2924,2935 ****
Body_Append : constant String :=
Get_Name_String
(Projects.Table
! (Main_Project).Naming.Body_Append);
Spec_Append : constant String :=
Get_Name_String
(Projects.Table
(Main_Project).
! Naming.Specification_Append);
begin
Get_Name_String (Main_Source_File);
--- 2957,2969 ----
Body_Append : constant String :=
Get_Name_String
(Projects.Table
! (Main_Project).
! Naming.Current_Impl_Suffix);
Spec_Append : constant String :=
Get_Name_String
(Projects.Table
(Main_Project).
! Naming.Current_Spec_Suffix);
begin
Get_Name_String (Main_Source_File);
***************
*** 3444,3450 ****
-- Avoid looking in the current directory for ALI files
! Opt.Look_In_Primary_Dir := False;
-- Set the project parsing verbosity to whatever was specified
-- by a possible -vP switch.
--- 3478,3484 ----
-- Avoid looking in the current directory for ALI files
! -- Opt.Look_In_Primary_Dir := False;
-- Set the project parsing verbosity to whatever was specified
-- by a possible -vP switch.
*** prj-attr.adb 2001/09/01 16:40:17 1.4
--- prj-attr.adb 2001/10/05 15:15:19 1.5
***************
*** 36,42 ****
-- Package names are preceded by 'P'
-- Attribute names are preceded by two capital letters:
-- 'S' for Single or 'L' for list, then
! -- 'V' for single variable, 'A' for associative array, or 'B' for both.
-- End is indicated by two consecutive '#'.
Initialisation_Data : constant String :=
--- 36,43 ----
-- Package names are preceded by 'P'
-- Attribute names are preceded by two capital letters:
-- 'S' for Single or 'L' for list, then
! -- 'V' for single variable, 'A' for associative array or
! -- 'a' for case insensitive associative array.
-- End is indicated by two consecutive '#'.
Initialisation_Data : constant String :=
***************
*** 53,80 ****
"SVlibrary_elaboration#" &
"SVlibrary_version#" &
"LVmain#" &
-- package Naming
"Pnaming#" &
! "SVspecification_append#" &
! "SVbody_append#" &
! "SVseparate_append#" &
"SVcasing#" &
"SVdot_replacement#" &
"SAspecification#" &
! "SAbody_part#" &
-- package Compiler
"Pcompiler#" &
! "LBswitches#" &
"SVlocal_configuration_pragmas#" &
! -- package gnatmake
! "Pgnatmake#" &
! "LBswitches#" &
"SVglobal_configuration_pragmas#" &
-- package gnatls
--- 54,86 ----
"SVlibrary_elaboration#" &
"SVlibrary_version#" &
"LVmain#" &
+ "LVlanguages#" &
-- package Naming
"Pnaming#" &
! "Saspecification_suffix#" &
! "Saimplementation_suffix#" &
! "SVseparate_suffix#" &
"SVcasing#" &
"SVdot_replacement#" &
"SAspecification#" &
! "SAimplementation#" &
! "LAspecification_exceptions#" &
! "LAimplementation_exceptions#" &
-- package Compiler
"Pcompiler#" &
! "Ladefault_switches#" &
! "LAswitches#" &
"SVlocal_configuration_pragmas#" &
! -- package Builder
! "Pbuilder#" &
! "Ladefault_switches#" &
! "LAswitches#" &
"SVglobal_configuration_pragmas#" &
-- package gnatls
***************
*** 82,97 ****
"Pgnatls#" &
"LVswitches#" &
! -- package gnatbind
! "Pgnatbind#" &
! "LBswitches#" &
! -- package gnatlink
! "Pgnatlink#" &
! "LBswitches#" &
"#";
----------------
--- 88,117 ----
"Pgnatls#" &
"LVswitches#" &
! -- package Binder
! "Pbinder#" &
! "Ladefault_switches#" &
! "LAswitches#" &
! -- package Linker
! "Plinker#" &
! "Ladefault_switches#" &
! "LAswitches#" &
+ -- package Cross_Reference
+
+ "Pcross_reference#" &
+ "Ladefault_switches#" &
+ "LAswitches#" &
+
+ -- package Finder
+
+ "Pfinder#" &
+ "Ladefault_switches#" &
+ "LAswitches#" &
+
"#";
----------------
***************
*** 162,169 ****
Kind_2 := Single;
when 'A' =>
Kind_2 := Associative_Array;
! when 'B' =>
! Kind_2 := Both;
when others =>
raise Program_Error;
end case;
--- 182,189 ----
Kind_2 := Single;
when 'A' =>
Kind_2 := Associative_Array;
! when 'a' =>
! Kind_2 := Case_Insensitive_Associative_Array;
when others =>
raise Program_Error;
end case;
*** prj-attr.ads 2001/04/20 17:19:11 1.1
--- prj-attr.ads 2001/10/05 15:15:23 1.2
***************
*** 51,57 ****
Empty_Attribute : constant Attribute_Node_Id
:= Attribute_Node_Low_Bound;
! type Attribute_Kind is (Single, Associative_Array, Both);
type Attribute_Record is record
Name : Name_Id;
--- 51,60 ----
Empty_Attribute : constant Attribute_Node_Id
:= Attribute_Node_Low_Bound;
! type Attribute_Kind is
! (Single,
! Associative_Array,
! Case_Insensitive_Associative_Array);
type Attribute_Record is record
Name : Name_Id;
*** prj-dect.adb 2001/07/23 16:57:46 1.5
--- prj-dect.adb 2001/10/05 15:15:30 1.6
***************
*** 131,136 ****
--- 131,143 ----
if Token = Tok_Identifier then
Set_Name_Of (Attribute, To => Token_Name);
Set_Location_Of (Attribute, To => Token_Ptr);
+
+ if Attributes.Table (Current_Attribute).Kind_2 =
+ Case_Insensitive_Associative_Array
+ then
+ Set_Case_Insensitive (Attribute, To => True);
+ end if;
+
while Current_Attribute /= Empty_Attribute
and then
Attributes.Table (Current_Attribute).Name /= Token_Name
*** prj-env.adb 2001/09/22 02:10:59 1.17
--- prj-env.adb 2001/10/05 15:15:34 1.18
***************
*** 470,476 ****
(File, "pragma Source_File_Name");
Put_Line
(File, " (Spec_File_Name => ""*" &
! Namet.Get_Name_String (Data.Naming.Specification_Append) &
""",");
Put_Line
(File, " Casing => " &
--- 470,476 ----
(File, "pragma Source_File_Name");
Put_Line
(File, " (Spec_File_Name => ""*" &
! Namet.Get_Name_String (Data.Naming.Current_Spec_Suffix) &
""",");
Put_Line
(File, " Casing => " &
***************
*** 486,492 ****
(File, "pragma Source_File_Name");
Put_Line
(File, " (Body_File_Name => ""*" &
! Namet.Get_Name_String (Data.Naming.Body_Append) &
""",");
Put_Line
(File, " Casing => " &
--- 486,492 ----
(File, "pragma Source_File_Name");
Put_Line
(File, " (Body_File_Name => ""*" &
! Namet.Get_Name_String (Data.Naming.Current_Impl_Suffix) &
""",");
Put_Line
(File, " Casing => " &
***************
*** 498,509 ****
-- and maybe separate
! if Data.Naming.Body_Append /= Data.Naming.Separate_Append then
Put_Line
(File, "pragma Source_File_Name");
Put_Line
(File, " (Subunit_File_Name => ""*" &
! Namet.Get_Name_String (Data.Naming.Separate_Append) &
""",");
Put_Line
(File, " Casing => " &
--- 498,511 ----
-- and maybe separate
! if
! Data.Naming.Current_Impl_Suffix /= Data.Naming.Separate_Suffix
! then
Put_Line
(File, "pragma Source_File_Name");
Put_Line
(File, " (Subunit_File_Name => ""*" &
! Namet.Get_Name_String (Data.Naming.Separate_Suffix) &
""",");
Put_Line
(File, " Casing => " &
***************
*** 714,720 ****
The_Packages := Projects.Table (Main_Project).Decl.Packages;
Gnatmake :=
Prj.Util.Value_Of
! (Name => Name_Gnatmake,
In_Packages => The_Packages);
if Gnatmake /= No_Package then
--- 716,722 ----
The_Packages := Projects.Table (Main_Project).Decl.Packages;
Gnatmake :=
Prj.Util.Value_Of
! (Name => Name_Builder,
In_Packages => The_Packages);
if Gnatmake /= No_Package then
***************
*** 800,809 ****
Extended_Spec_Name : String :=
Name & Namet.Get_Name_String
! (Data.Naming.Specification_Append);
Extended_Body_Name : String :=
Name & Namet.Get_Name_String
! (Data.Naming.Body_Append);
Unit : Unit_Data;
--- 802,811 ----
Extended_Spec_Name : String :=
Name & Namet.Get_Name_String
! (Data.Naming.Current_Spec_Suffix);
Extended_Body_Name : String :=
Name & Namet.Get_Name_String
! (Data.Naming.Current_Impl_Suffix);
Unit : Unit_Data;
***************
*** 1252,1261 ****
Extended_Spec_Name : String :=
Name & Namet.Get_Name_String
! (Data.Naming.Specification_Append);
Extended_Body_Name : String :=
Name & Namet.Get_Name_String
! (Data.Naming.Body_Append);
First : Unit_Id := Units.First;
Current : Unit_Id;
--- 1254,1263 ----
Extended_Spec_Name : String :=
Name & Namet.Get_Name_String
! (Data.Naming.Current_Spec_Suffix);
Extended_Body_Name : String :=
Name & Namet.Get_Name_String
! (Data.Naming.Current_Impl_Suffix);
First : Unit_Id := Units.First;
Current : Unit_Id;
*** prj-nmsc.adb 2001/09/09 00:38:56 1.25
--- prj-nmsc.adb 2001/10/05 15:15:41 1.26
***************
*** 31,36 ****
--- 31,37 ----
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
with Errout; use Errout;
+ with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Namet; use Namet;
***************
*** 48,60 ****
Error_Report : Put_Line_Access := null;
! procedure Check_Naming_Scheme (Naming : Naming_Data);
-- Check that the package Naming is correct.
! procedure Check_Naming_Scheme
(Name : Name_Id;
Unit : out Name_Id);
! -- Check that a name is a valid unit name.
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
-- Output an error message.
--- 49,61 ----
Error_Report : Put_Line_Access := null;
! procedure Check_Ada_Naming_Scheme (Naming : Naming_Data);
-- Check that the package Naming is correct.
! procedure Check_Ada_Name
(Name : Name_Id;
Unit : out Name_Id);
! -- Check that a name is a valid Ada unit name.
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
-- Output an error message.
***************
*** 84,96 ****
Path_Name : Name_Id;
Project : Project_Id;
Data : in out Project_Data;
- Error_If_Invalid : Boolean;
Location : Source_Ptr;
Current_Source : in out String_List_Id);
-- Put a unit in the list of units of a project, if the file name
-- corresponds to a valid unit name.
- -- If it does not correspond to a valid unit name, report an error
- -- only if Error_If_Invalid is true.
procedure Show_Source_Dirs (Project : Project_Id);
-- List all the source directories of a project.
--- 85,94 ----
***************
*** 116,344 ****
-- Same as above except that Directory is a String_Id instead
-- of a Name_Id.
! -------------------------
! -- Check_Naming_Scheme --
! -------------------------
!
! procedure Check_Naming_Scheme (Naming : Naming_Data) is
! begin
! -- Only check if we are not using the standard naming scheme
!
! if Naming /= Standard_Naming_Data then
! declare
! Dot_Replacement : constant String :=
! Get_Name_String
! (Naming.Dot_Replacement);
! Specification_Append : constant String :=
! Get_Name_String
! (Naming.Specification_Append);
! Body_Append : constant String :=
! Get_Name_String
! (Naming.Body_Append);
! Separate_Append : constant String :=
! Get_Name_String
! (Naming.Separate_Append);
!
! begin
! -- Dot_Replacement cannot
! -- - be empty
! -- - start or end with an alphanumeric
! -- - be a single '_'
! -- - start with an '_' followed by an alphanumeric
! -- - contain a '.' except if it is "."
!
! if Dot_Replacement'Length = 0
! or else Is_Alphanumeric
! (Dot_Replacement (Dot_Replacement'First))
! or else Is_Alphanumeric
! (Dot_Replacement (Dot_Replacement'Last))
! or else (Dot_Replacement (Dot_Replacement'First) = '_'
! and then
! (Dot_Replacement'Length = 1
! or else
! Is_Alphanumeric
! (Dot_Replacement (Dot_Replacement'First + 1))))
! or else (Dot_Replacement'Length > 1
! and then
! Index (Source => Dot_Replacement,
! Pattern => ".") /= 0)
! then
! Error_Msg
! ('"' & Dot_Replacement &
! """ is illegal for Dot_Replacement.",
! Naming.Dot_Repl_Loc);
! end if;
!
! -- Appends cannot
! -- - be empty
! -- - start with an alphanumeric
! -- - start with an '_' followed by an alphanumeric
!
! if Is_Illegal_Append (Specification_Append) then
! Error_Msg
! ('"' & Specification_Append &
! """ is illegal for Specification_Append.",
! Naming.Spec_Append_Loc);
! end if;
!
! if Is_Illegal_Append (Body_Append) then
! Error_Msg
! ('"' & Body_Append &
! """ is illegal for Body_Append.",
! Naming.Body_Append_Loc);
! end if;
!
! if Body_Append /= Separate_Append then
! if Is_Illegal_Append (Separate_Append) then
! Error_Msg
! ('"' & Separate_Append &
! """ is illegal for Separate_Append.",
! Naming.Sep_Append_Loc);
! end if;
! end if;
!
! -- Specification_Append cannot have the same termination as
! -- Body_Append or Separate_Append
!
! if Specification_Append'Length >= Body_Append'Length
! and then
! Body_Append (Body_Append'Last -
! Specification_Append'Length + 1 ..
! Body_Append'Last) = Specification_Append
! then
! Error_Msg
! ("Body_Append (""" &
! Body_Append &
! """) cannot end with" &
! " Specification_Append (""" &
! Specification_Append & """).",
! Naming.Body_Append_Loc);
! end if;
!
! if Specification_Append'Length >= Separate_Append'Length
! and then
! Separate_Append
! (Separate_Append'Last - Specification_Append'Length + 1
! ..
! Separate_Append'Last) = Specification_Append
! then
! Error_Msg
! ("Separate_Append (""" &
! Separate_Append &
! """) cannot end with" &
! " Specification_Append (""" &
! Specification_Append & """).",
! Naming.Sep_Append_Loc);
! end if;
! end;
! end if;
! end Check_Naming_Scheme;
!
! procedure Check_Naming_Scheme
! (Name : Name_Id;
! Unit : out Name_Id)
! is
! The_Name : String := Get_Name_String (Name);
! Need_Letter : Boolean := True;
! Last_Underscore : Boolean := False;
! OK : Boolean := The_Name'Length > 0;
!
! begin
! for Index in The_Name'Range loop
! if Need_Letter then
!
! -- We need a letter (at the beginning, and following a dot),
! -- but we don't have one.
!
! if Is_Letter (The_Name (Index)) then
! Need_Letter := False;
!
! else
! OK := False;
!
! if Current_Verbosity = High then
! Write_Int (Types.Int (Index));
! Write_Str (": '");
! Write_Char (The_Name (Index));
! Write_Line ("' is not a letter.");
! end if;
!
! exit;
! end if;
!
! elsif Last_Underscore
! and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
! then
! -- Two underscores are illegal, and a dot cannot follow
! -- an underscore.
!
! OK := False;
!
! if Current_Verbosity = High then
! Write_Int (Types.Int (Index));
! Write_Str (": '");
! Write_Char (The_Name (Index));
! Write_Line ("' is illegal here.");
! end if;
!
! exit;
!
! elsif The_Name (Index) = '.' then
!
! -- We need a letter after a dot
!
! Need_Letter := True;
!
! elsif The_Name (Index) = '_' then
! Last_Underscore := True;
!
! else
! -- We need an letter or a digit
!
! Last_Underscore := False;
!
! if not Is_Alphanumeric (The_Name (Index)) then
! OK := False;
!
! if Current_Verbosity = High then
! Write_Int (Types.Int (Index));
! Write_Str (": '");
! Write_Char (The_Name (Index));
! Write_Line ("' is not alphanumeric.");
! end if;
!
! exit;
! end if;
! end if;
! end loop;
!
! -- We cannot end with an underscore or a dot
!
! OK := OK and then not Need_Letter and then not Last_Underscore;
!
! if OK then
! Unit := Name;
! else
! -- We signal a problem with No_Name
!
! Unit := No_Name;
! end if;
! end Check_Naming_Scheme;
! procedure Check_Naming_Scheme
(Project : Project_Id;
Report_Error : Put_Line_Access)
is
! Last_Source_Dir : String_List_Id := Nil_String;
! Data : Project_Data := Projects.Table (Project);
procedure Check_Unit_Names (List : Array_Element_Id);
-- Check that a list of unit names contains only valid names.
- procedure Find_Source_Dirs (From : String_Id; Location : Source_Ptr);
- -- Find one or several source directories, and add them
- -- to the list of source directories of the project.
-
procedure Find_Sources;
-- Find all the sources in all of the source directories
-- of a project.
--- 114,133 ----
-- Same as above except that Directory is a String_Id instead
-- of a Name_Id.
! ---------------
! -- Ada_Check --
! ---------------
! procedure Ada_Check
(Project : Project_Id;
Report_Error : Put_Line_Access)
is
! Data : Project_Data;
! Languages : Variable_Value := Nil_Variable_Value;
procedure Check_Unit_Names (List : Array_Element_Id);
-- Check that a list of unit names contains only valid names.
procedure Find_Sources;
-- Find all the sources in all of the source directories
-- of a project.
***************
*** 372,378 ****
-- Check that it contains a valid unit name
! Check_Naming_Scheme (Element.Index, Unit_Name);
if Unit_Name = No_Name then
Error_Msg_Name_1 := Element.Index;
--- 161,167 ----
-- Check that it contains a valid unit name
! Check_Ada_Name (Element.Index, Unit_Name);
if Unit_Name = No_Name then
Error_Msg_Name_1 := Element.Index;
***************
*** 396,691 ****
end loop;
end Check_Unit_Names;
! ----------------------
! -- Find_Source_Dirs --
! ----------------------
! procedure Find_Source_Dirs (From : String_Id; Location : Source_Ptr) is
! Directory : String (1 .. Integer (String_Length (From)));
! Directory_Id : Name_Id;
! Element : String_Element;
! procedure Recursive_Find_Dirs (Path : String_Id);
! -- Find all the subdirectories (recursively) of Path
! -- and add them to the list of source directories
! -- of the project.
! -------------------------
! -- Recursive_Find_Dirs --
! -------------------------
! procedure Recursive_Find_Dirs (Path : String_Id) is
! Dir : Dir_Type;
! Name : String (1 .. 250);
! Last : Natural;
! The_Path : String := Get_Name_String (Path) & Dir_Sep;
! The_Path_Last : Positive := The_Path'Last;
! begin
! if The_Path'Length > 1
! and then
! (The_Path (The_Path_Last - 1) = Dir_Sep
! or else The_Path (The_Path_Last - 1) = '/')
! then
! The_Path_Last := The_Path_Last - 1;
! end if;
! if Current_Verbosity = High then
! Write_Str (" ");
! Write_Line (The_Path (The_Path'First .. The_Path_Last));
! end if;
! String_Elements.Increment_Last;
! Element :=
! (Value => Path,
! Location => No_Location,
! Next => Nil_String);
! -- Case of first source directory
! if Last_Source_Dir = Nil_String then
! Data.Source_Dirs := String_Elements.Last;
- -- Here we already have source directories.
-
- else
- -- Link the previous last to the new one
-
- String_Elements.Table (Last_Source_Dir).Next :=
- String_Elements.Last;
- end if;
-
- -- And register this source directory as the new last
-
- Last_Source_Dir := String_Elements.Last;
- String_Elements.Table (Last_Source_Dir) := Element;
-
- -- Now look for subdirectories
-
- Open (Dir, The_Path (The_Path'First .. The_Path_Last));
-
- loop
- Read (Dir, Name, Last);
- exit when Last = 0;
-
- if Current_Verbosity = High then
- Write_Str (" Checking ");
- Write_Line (Name (1 .. Last));
- end if;
-
- if Name (1 .. Last) /= "."
- and then Name (1 .. Last) /= ".."
- then
- -- Avoid . and ..
-
- declare
- Path_Name : constant String :=
- The_Path (The_Path'First .. The_Path_Last) &
- Name (1 .. Last);
-
- begin
- if Is_Directory (Path_Name) then
-
- -- We have found a new subdirectory,
- -- register it and find its own subdirectories.
-
- Start_String;
- Store_String_Chars (Path_Name);
- Recursive_Find_Dirs (End_String);
- end if;
- end;
- end if;
- end loop;
-
- Close (Dir);
-
- exception
- when Directory_Error =>
- null;
- end Recursive_Find_Dirs;
-
- -- Start of processing for Find_Source_Dirs
-
- begin
- if Current_Verbosity = High then
- Write_Str ("Find_Source_Dirs (""");
- end if;
-
- String_To_Name_Buffer (From);
- Directory := Name_Buffer (1 .. Name_Len);
- Directory_Id := Name_Find;
-
- if Current_Verbosity = High then
- Write_Str (Directory);
- Write_Line (""")");
- end if;
-
- -- First, check if we are looking for a directory tree,
- -- indicated by "/**" at the end.
-
- if Directory'Length >= 3
- and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
- and then (Directory (Directory'Last - 2) = '/'
- or else
- Directory (Directory'Last - 2) = Dir_Sep)
- then
- Name_Len := Directory'Length - 3;
-
- if Name_Len = 0 then
- -- This is the case of "/**": all directories
- -- in the file system.
-
- Name_Len := 1;
- Name_Buffer (1) := Directory (Directory'First);
-
- else
- Name_Buffer (1 .. Name_Len) :=
- Directory (Directory'First .. Directory'Last - 3);
- end if;
-
- if Current_Verbosity = High then
- Write_Str ("Looking for all subdirectories of """);
- Write_Str (Name_Buffer (1 .. Name_Len));
- Write_Line ("""");
- end if;
-
- declare
- Base_Dir : constant Name_Id := Name_Find;
- Root : constant Name_Id :=
- Locate_Directory (Base_Dir, Data.Directory);
-
- begin
- if Root = No_Name then
- Error_Msg_Name_1 := Base_Dir;
- if Location = No_Location then
- Error_Msg ("{ is not a valid directory.", Data.Location);
- else
- Error_Msg ("{ is not a valid directory.", Location);
- end if;
-
- else
- -- We have an existing directory,
- -- we register it and all of its subdirectories.
-
- if Current_Verbosity = High then
- Write_Line ("Looking for source directories:");
- end if;
-
- Start_String;
- Store_String_Chars (Get_Name_String (Root));
- Recursive_Find_Dirs (End_String);
-
- if Current_Verbosity = High then
- Write_Line ("End of looking for source directories.");
- end if;
- end if;
- end;
-
- -- We have a single directory
-
- else
- declare
- Path_Name : constant Name_Id :=
- Locate_Directory (Directory_Id, Data.Directory);
-
- begin
- if Path_Name = No_Name then
- Error_Msg_Name_1 := Directory_Id;
- if Location = No_Location then
- Error_Msg ("{ is not a valid directory", Data.Location);
- else
- Error_Msg ("{ is not a valid directory", Location);
- end if;
- else
-
- -- As it is an existing directory, we add it to
- -- the list of directories.
-
- String_Elements.Increment_Last;
- Start_String;
- Store_String_Chars (Get_Name_String (Path_Name));
- Element.Value := End_String;
-
- if Last_Source_Dir = Nil_String then
-
- -- This is the first source directory
-
- Data.Source_Dirs := String_Elements.Last;
-
- else
- -- We already have source directories,
- -- link the previous last to the new one.
-
- String_Elements.Table (Last_Source_Dir).Next :=
- String_Elements.Last;
- end if;
-
- -- And register this source directory as the new last
-
- Last_Source_Dir := String_Elements.Last;
- String_Elements.Table (Last_Source_Dir) := Element;
- end if;
- end;
- end if;
- end Find_Source_Dirs;
-
- ------------------
- -- Find_Sources --
- ------------------
-
- procedure Find_Sources is
- Source_Dir : String_List_Id := Data.Source_Dirs;
- Element : String_Element;
- Dir : Dir_Type;
- Current_Source : String_List_Id := Nil_String;
-
- begin
- if Current_Verbosity = High then
- Write_Line ("Looking for sources:");
- end if;
-
- -- For each subdirectory
-
- while Source_Dir /= Nil_String loop
- begin
- Element := String_Elements.Table (Source_Dir);
- if Element.Value /= No_String then
- declare
- Source_Directory : String
- (1 .. Integer (String_Length (Element.Value)));
- begin
- String_To_Name_Buffer (Element.Value);
- Source_Directory := Name_Buffer (1 .. Name_Len);
- if Current_Verbosity = High then
- Write_Str ("Source_Dir = ");
- Write_Line (Source_Directory);
- end if;
-
- -- We look to every entry in the source directory
-
- Open (Dir, Source_Directory);
-
- loop
- Read (Dir, Name_Buffer, Name_Len);
-
- if Current_Verbosity = High then
- Write_Str (" Checking ");
- Write_Line (Name_Buffer (1 .. Name_Len));
- end if;
-
- exit when Name_Len = 0;
-
- declare
- Path_Access : constant GNAT.OS_Lib.String_Access :=
- Locate_Regular_File
- (Name_Buffer (1 .. Name_Len),
- Source_Directory);
-
- File_Name : Name_Id;
- Path_Name : Name_Id;
-
begin
-- If it is a regular file
--- 185,245 ----
end loop;
end Check_Unit_Names;
! ------------------
! -- Find_Sources --
! ------------------
! procedure Find_Sources is
! Source_Dir : String_List_Id := Data.Source_Dirs;
! Element : String_Element;
! Dir : Dir_Type;
! Current_Source : String_List_Id := Nil_String;
! begin
! if Current_Verbosity = High then
! Write_Line ("Looking for sources:");
! end if;
! -- For each subdirectory
! while Source_Dir /= Nil_String loop
! begin
! Element := String_Elements.Table (Source_Dir);
! if Element.Value /= No_String then
! declare
! Source_Directory : String
! (1 .. Integer (String_Length (Element.Value)));
! begin
! String_To_Name_Buffer (Element.Value);
! Source_Directory := Name_Buffer (1 .. Name_Len);
! if Current_Verbosity = High then
! Write_Str ("Source_Dir = ");
! Write_Line (Source_Directory);
! end if;
! -- We look to every entry in the source directory
! Open (Dir, Source_Directory);
! loop
! Read (Dir, Name_Buffer, Name_Len);
! if Current_Verbosity = High then
! Write_Str (" Checking ");
! Write_Line (Name_Buffer (1 .. Name_Len));
! end if;
! exit when Name_Len = 0;
! declare
! Path_Access : constant GNAT.OS_Lib.String_Access :=
! Locate_Regular_File
! (Name_Buffer (1 .. Name_Len),
! Source_Directory);
! File_Name : Name_Id;
! Path_Name : Name_Id;
begin
-- If it is a regular file
***************
*** 707,713 ****
Path_Name => Path_Name,
Project => Project,
Data => Data,
- Error_If_Invalid => False,
Location => No_Location,
Current_Source => Current_Source);
--- 261,266 ----
***************
*** 804,810 ****
Path_Name => Name_Find,
Project => Project,
Data => Data,
- Error_If_Invalid => True,
Location => Location,
Current_Source => Current_Source);
Found := True;
--- 357,362 ----
***************
*** 819,831 ****
end if;
end loop;
- if not Found then
- Name_Len := File_Name'Length;
- Name_Buffer (1 .. Name_Len) := File_Name;
- Error_Msg_Name_1 := Name_Find;
- Error_Msg
- ("cannot find source {", Location);
- end if;
end Get_Path_Name_And_Record_Source;
---------------------------
--- 371,376 ----
***************
*** 886,1575 ****
end if;
end Get_Sources_From_File;
! -- Start of processing for Check_Naming_Scheme
begin
Error_Report := Report_Error;
! if Current_Verbosity = High then
! Write_Line ("Starting to look for directories");
! end if;
! -- Let's check the object directory
! declare
! Object_Dir : Variable_Value :=
! Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes);
! begin
! pragma Assert (Object_Dir.Kind = Single,
! "Object_Dir is not a single string");
! -- We set the object directory to its default
! Data.Object_Directory := Data.Directory;
! if not String_Equal (Object_Dir.Value, Empty_String) then
!
! String_To_Name_Buffer (Object_Dir.Value);
! if Name_Len = 0 then
! Error_Msg ("Object_Dir cannot be empty",
! Object_Dir.Location);
! else
! -- We check that the specified object directory
! -- does exist.
! Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
! declare
! Dir_Id : constant Name_Id := Name_Find;
! begin
! Data.Object_Directory :=
! Locate_Directory (Dir_Id, Data.Directory);
! if Data.Object_Directory = No_Name then
! Error_Msg_Name_1 := Dir_Id;
! Error_Msg
! ("the object directory { cannot be found",
! Data.Location);
! end if;
! end;
end if;
- end if;
- end;
! if Current_Verbosity = High then
! if Data.Object_Directory = No_Name then
! Write_Line ("No object directory");
! else
! Write_Str ("Object directory: """);
! Write_Str (Get_Name_String (Data.Object_Directory));
! Write_Line ("""");
! end if;
! end if;
! -- Let's check the source directories
! declare
! Source_Dirs : Variable_Value :=
! Util.Value_Of (Name_Source_Dirs, Data.Decl.Attributes);
! begin
! if Current_Verbosity = High then
! Write_Line ("Starting to look for source directories");
! end if;
! pragma Assert (Source_Dirs.Kind = List,
! "Source_Dirs is not a list");
! if Source_Dirs.Default then
! -- No Source_Dirs specified: the single source directory
! -- is the one containing the project file
! String_Elements.Increment_Last;
! Data.Source_Dirs := String_Elements.Last;
! Start_String;
! Store_String_Chars (Get_Name_String (Data.Directory));
! String_Elements.Table (Data.Source_Dirs) :=
! (Value => End_String,
! Location => No_Location,
! Next => Nil_String);
! if Current_Verbosity = High then
! Write_Line ("(Undefined) Single object directory:");
! Write_Str (" """);
! Write_Str (Get_Name_String (Data.Directory));
! Write_Line ("""");
! end if;
! elsif Source_Dirs.Values = Nil_String then
! -- If Source_Dirs is an empty string list, this means
! -- that this project contains no source.
! if Data.Object_Directory = Data.Directory then
! Data.Object_Directory := No_Name;
! end if;
! Data.Source_Dirs := Nil_String;
- else
declare
! Source_Dir : String_List_Id := Source_Dirs.Values;
! Element : String_Element;
begin
! -- We will find the source directories for each
! -- element of the list
! while Source_Dir /= Nil_String loop
! Element := String_Elements.Table (Source_Dir);
! Find_Source_Dirs (Element.Value, Element.Location);
! Source_Dir := Element.Next;
! end loop;
! end;
! end if;
! if Current_Verbosity = High then
! Write_Line ("Puting source directories in canonical cases");
! end if;
! declare
! Current : String_List_Id := Data.Source_Dirs;
! Element : String_Element;
! begin
! while Current /= Nil_String loop
! Element := String_Elements.Table (Current);
! if Element.Value /= No_String then
! String_To_Name_Buffer (Element.Value);
! Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
! Start_String;
! Store_String_Chars (Name_Buffer (1 .. Name_Len));
! Element.Value := End_String;
! String_Elements.Table (Current) := Element;
end if;
! Current := Element.Next;
! end loop;
! end;
! end;
! -- Library Dir, Name, Version and Kind
! declare
! Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
! Lib_Dir : Prj.Variable_Value :=
! Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes);
! Lib_Name : Prj.Variable_Value :=
! Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes);
! Lib_Version : Prj.Variable_Value :=
! Prj.Util.Value_Of
! (Snames.Name_Library_Version, Attributes);
! The_Lib_Kind : Prj.Variable_Value :=
! Prj.Util.Value_Of
! (Snames.Name_Library_Kind, Attributes);
! begin
! pragma Assert (Lib_Dir.Kind = Single);
! if Lib_Dir.Value = Empty_String then
if Current_Verbosity = High then
! Write_Line ("No library directory");
end if;
-
- else
- -- Find path name, check that it is a directory
! Stringt.String_To_Name_Buffer (Lib_Dir.Value);
declare
! Dir_Id : constant Name_Id := Name_Find;
begin
! Data.Library_Dir :=
! Locate_Directory (Dir_Id, Data.Directory);
!
! if Data.Library_Dir = No_Name then
! Error_Msg ("not an existing directory",
! Lib_Dir.Location);
!
! elsif Data.Library_Dir = Data.Object_Directory then
! Error_Msg
! ("library directory cannot be the same " &
! "as object directory",
! Lib_Dir.Location);
! Data.Library_Dir := No_Name;
else
! if Current_Verbosity = High then
! Write_Str ("Library directory =""");
! Write_Str (Get_Name_String (Data.Library_Dir));
! Write_Line ("""");
! end if;
end if;
end;
- end if;
-
- pragma Assert (Lib_Name.Kind = Single);
- if Lib_Name.Value = Empty_String then
if Current_Verbosity = High then
! Write_Line ("No library name");
! end if;
!
! else
! Stringt.String_To_Name_Buffer (Lib_Name.Value);
! if not Is_Letter (Name_Buffer (1)) then
! Error_Msg ("must start with a letter",
! Lib_Name.Location);
! else
! Data.Library_Name := Name_Find;
! for Index in 2 .. Name_Len loop
! if not Is_Alphanumeric (Name_Buffer (Index)) then
! Data.Library_Name := No_Name;
! Error_Msg ("only letters and digits are allowed",
! Lib_Name.Location);
! exit;
! end if;
! end loop;
! if Data.Library_Name /= No_Name
! and then Current_Verbosity = High then
! Write_Str ("Library name = """);
! Write_Str (Get_Name_String (Data.Library_Name));
! Write_Line ("""");
end if;
! end if;
! end if;
!
! Data.Library :=
! Data.Library_Dir /= No_Name
! and then
! Data.Library_Name /= No_Name;
- if Data.Library then
if Current_Verbosity = High then
! Write_Line ("This is a library project file");
end if;
-
- pragma Assert (Lib_Version.Kind = Single);
-
- if Lib_Version.Value = Empty_String then
- if Current_Verbosity = High then
- Write_Line ("No library version specified");
- end if;
! else
! Stringt.String_To_Name_Buffer (Lib_Version.Value);
! Data.Lib_Internal_Name := Name_Find;
! end if;
! pragma Assert (The_Lib_Kind.Kind = Single);
! if The_Lib_Kind.Value = Empty_String then
! if Current_Verbosity = High then
! Write_Line ("No library kind specified");
! end if;
! else
! Stringt.String_To_Name_Buffer (The_Lib_Kind.Value);
! declare
! Kind_Name : constant String :=
! Ada.Characters.Handling.To_Lower
! (Name_Buffer (1 .. Name_Len));
! OK : Boolean := True;
! begin
! if Kind_Name = "static" then
! Data.Library_Kind := Static;
! elsif Kind_Name = "dynamic" then
! Data.Library_Kind := Dynamic;
! elsif Kind_Name = "relocatable" then
! Data.Library_Kind := Relocatable;
! else
! Error_Msg
! ("illegal value for Library_Kind",
! The_Lib_Kind.Location);
! OK := False;
! end if;
! if Current_Verbosity = High and then OK then
! Write_Str ("Library kind = ");
! Write_Line (Kind_Name);
! end if;
! end;
! end if;
end if;
end;
-
- if Current_Verbosity = High then
- Show_Source_Dirs (Project);
- end if;
! declare
! Naming_Id : constant Package_Id :=
! Util.Value_Of (Name_Naming, Data.Decl.Packages);
! Naming : Package_Element;
! begin
! -- If there is a package Naming, we will put in Data.Naming
! -- what is in this package Naming.
! if Naming_Id /= No_Package then
! Naming := Packages.Table (Naming_Id);
! if Current_Verbosity = High then
! Write_Line ("Checking ""Naming"".");
! end if;
! declare
! Bodies : constant Array_Element_Id :=
! Util.Value_Of (Name_Body_Part, Naming.Decl.Arrays);
! Specifications : constant Array_Element_Id :=
! Util.Value_Of
! (Name_Specification, Naming.Decl.Arrays);
! begin
! if Bodies /= No_Array_Element then
! -- We have elements in the array Body_Part
! if Current_Verbosity = High then
! Write_Line ("Found Bodies.");
! end if;
! Data.Naming.Bodies := Bodies;
! Check_Unit_Names (Bodies);
! else
! if Current_Verbosity = High then
! Write_Line ("No Bodies.");
! end if;
! end if;
! if Specifications /= No_Array_Element then
! -- We have elements in the array Specification
! if Current_Verbosity = High then
! Write_Line ("Found Specifications.");
! end if;
! Data.Naming.Specifications := Specifications;
! Check_Unit_Names (Specifications);
else
! if Current_Verbosity = High then
! Write_Line ("No Specifications.");
! end if;
end if;
end;
!
! -- We are now checking if variables Dot_Replacement, Casing,
! -- Specification_Append, Body_Append and/or Separate_Append
! -- exist.
! -- For each variable, if it does not exist, we do nothing,
! -- because we already have the default.
! -- Let's check Dot_Replacement
! declare
! Dot_Replacement : constant Variable_Value :=
! Util.Value_Of
! (Name_Dot_Replacement,
! Naming.Decl.Attributes);
! begin
! pragma Assert (Dot_Replacement.Kind = Single,
! "Dot_Replacement is not a single string");
! if not Dot_Replacement.Default then
! String_To_Name_Buffer (Dot_Replacement.Value);
! if Name_Len = 0 then
! Error_Msg ("Dot_Replacement cannot be empty",
! Dot_Replacement.Location);
! else
! Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
! Data.Naming.Dot_Replacement := Name_Find;
! Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
! end if;
end if;
! end;
if Current_Verbosity = High then
! Write_Str (" Dot_Replacement = """);
! Write_Str (Get_Name_String (Data.Naming.Dot_Replacement));
! Write_Char ('"');
! Write_Eol;
end if;
! -- Check Casing
! declare
! Casing_String : constant Variable_Value :=
! Util.Value_Of (Name_Casing, Naming.Decl.Attributes);
! begin
! pragma Assert (Casing_String.Kind = Single,
! "Dot_Replacement is not a single string");
! if not Casing_String.Default then
! declare
! Casing_Image : constant String :=
! Get_Name_String (Casing_String.Value);
! begin
! declare
! Casing : constant Casing_Type :=
! Value (Casing_Image);
! begin
! Data.Naming.Casing := Casing;
! end;
! exception
! when Constraint_Error =>
! if Casing_Image'Length = 0 then
! Error_Msg ("Casing cannot be an empty string",
! Casing_String.Location);
! else
! Name_Len := Casing_Image'Length;
! Name_Buffer (1 .. Name_Len) := Casing_Image;
! Error_Msg_Name_1 := Name_Find;
! Error_Msg
! ("{ is not a correct Casing",
! Casing_String.Location);
! end if;
! end;
! end if;
! end;
!
! if Current_Verbosity = High then
! Write_Str (" Casing = ");
! Write_Str (Image (Data.Naming.Casing));
! Write_Char ('.');
! Write_Eol;
! end if;
!
! -- Let's check Specification_Append
!
! declare
! Specification_Append : constant Variable_Value :=
! Util.Value_Of
! (Name_Specification_Append,
! Naming.Decl.Attributes);
!
! begin
! pragma Assert (Specification_Append.Kind = Single,
! "Specification_Append is not a single string");
!
! if not Specification_Append.Default then
! String_To_Name_Buffer (Specification_Append.Value);
!
! if Name_Len = 0 then
! Error_Msg ("Specification_Append cannot be empty",
! Specification_Append.Location);
! else
! Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
! Data.Naming.Specification_Append := Name_Find;
! Data.Naming.Spec_Append_Loc :=
! Specification_Append.Location;
! end if;
end if;
- end;
! if Current_Verbosity = High then
! Write_Str (" Specification_Append = """);
! Write_Str (Get_Name_String (Data.Naming.Specification_Append));
! Write_Line (""".");
end if;
!
! -- Check Body_Append
!
! declare
! Body_Append : constant Variable_Value :=
! Util.Value_Of
! (Name_Body_Append, Naming.Decl.Attributes);
!
! begin
! pragma Assert (Body_Append.Kind = Single,
! "Body_Append is not a single string");
!
! if not Body_Append.Default then
!
! String_To_Name_Buffer (Body_Append.Value);
! if Name_Len = 0 then
! Error_Msg ("Body_Append cannot be empty",
! Body_Append.Location);
! else
! Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
! Data.Naming.Body_Append := Name_Find;
! Data.Naming.Body_Append_Loc := Body_Append.Location;
! -- As we have a new Body_Append, we set Separate_Append
! -- to the same value.
! Data.Naming.Separate_Append := Data.Naming.Body_Append;
! Data.Naming.Sep_Append_Loc := Data.Naming.Body_Append_Loc;
! end if;
! end if;
! end;
! if Current_Verbosity = High then
! Write_Str (" Body_Append = """);
! Write_Str (Get_Name_String (Data.Naming.Body_Append));
! Write_Line (""".");
! end if;
! -- Check Separate_Append
! declare
! Separate_Append : constant Variable_Value :=
! Util.Value_Of
! (Name_Separate_Append,
! Naming.Decl.Attributes);
! begin
! pragma Assert (Separate_Append.Kind = Single,
! "Separate_Append is not a single string");
! if not Separate_Append.Default then
! String_To_Name_Buffer (Separate_Append.Value);
! if Name_Len = 0 then
! Error_Msg ("Separate_Append cannot be empty",
! Separate_Append.Location);
! else
! Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
! Data.Naming.Separate_Append := Name_Find;
! Data.Naming.Sep_Append_Loc := Separate_Append.Location;
! end if;
! end if;
! end;
! if Current_Verbosity = High then
! Write_Str (" Separate_Append = """);
! Write_Str (Get_Name_String (Data.Naming.Separate_Append));
! Write_Line (""".");
! Write_Line ("end Naming.");
end if;
-
- -- Now, we check if Data.Naming is valid
! Check_Naming_Scheme (Data.Naming);
! end if;
! end;
!
! -- If we have source directories, then let's find the sources.
! if Data.Source_Dirs /= Nil_String then
! declare
! Sources : constant Variable_Value :=
! Util.Value_Of
! (Name_Source_Files,
! Data.Decl.Attributes);
!
! Source_List_File : constant Variable_Value :=
! Util.Value_Of
! (Name_Source_List_File,
! Data.Decl.Attributes);
! begin
! pragma Assert
! (Sources.Kind = List,
! "Source_Files is not a list");
! pragma Assert
! (Source_List_File.Kind = Single,
! "Source_List_File is not a single string");
! if not Sources.Default then
! if not Source_List_File.Default then
Error_Msg
! ("?both variables source_files and " &
! "source_list_file are present",
! Source_List_File.Location);
end if;
!
! -- Sources is a list of file names
!
! declare
! Current_Source : String_List_Id := Nil_String;
! Current : String_List_Id := Sources.Values;
! Element : String_Element;
!
! begin
! while Current /= Nil_String loop
! Element := String_Elements.Table (Current);
! String_To_Name_Buffer (Element.Value);
!
! declare
! File_Name : constant String :=
! Name_Buffer (1 .. Name_Len);
!
! begin
! Get_Path_Name_And_Record_Source
! (File_Name => File_Name,
! Location => Element.Location,
! Current_Source => Current_Source);
! Current := Element.Next;
! end;
! end loop;
! end;
!
! -- No source_files specified.
! -- We check Source_List_File has been specified.
!
! elsif not Source_List_File.Default then
!
! -- Source_List_File is the name of the file
! -- that contains the source file names
!
! declare
! Source_File_Path_Name : constant String :=
! Path_Name_Of
! (Source_List_File.Value,
! Data.Directory);
!
! begin
! if Source_File_Path_Name'Length = 0 then
! String_To_Name_Buffer (Source_List_File.Value);
! Error_Msg_Name_1 := Name_Find;
! Error_Msg
! ("file with sources { does not exist",
! Source_List_File.Location);
! else
! Get_Sources_From_File
! (Source_File_Path_Name,
! Source_List_File.Location);
! end if;
! end;
! else
! -- Neither Source_Files nor Source_List_File has been
! -- specified.
! -- Find all the files that satisfy
! -- the naming scheme in all the source directories.
! Find_Sources;
end if;
end;
end if;
!
! Projects.Table (Project) := Data;
! end Check_Naming_Scheme;
---------------
-- Error_Msg --
--- 431,1047 ----
end if;
end Get_Sources_From_File;
! -- Start of processing for Ada_Check
begin
+ Language_Independent_Check (Project, Report_Error);
+
Error_Report := Report_Error;
! Data := Projects.Table (Project);
! Languages := Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes);
! Data.Naming.Current_Language := Name_Ada;
! Data.Sources_Present := Data.Source_Dirs /= Nil_String;
! if not Languages.Default then
! declare
! Current : String_List_Id := Languages.Values;
! Element : String_Element;
! Ada_Found : Boolean := False;
! begin
! Look_For_Ada : while Current /= Nil_String loop
! Element := String_Elements.Table (Current);
! String_To_Name_Buffer (Element.Value);
! To_Lower (Name_Buffer (1 .. Name_Len));
! if Name_Buffer (1 .. Name_Len) = "ada" then
! Ada_Found := True;
! exit Look_For_Ada;
! end if;
! Current := Element.Next;
! end loop Look_For_Ada;
! if not Ada_Found then
! -- Mark the project file as having no sources for Ada
! Data.Sources_Present := False;
! end if;
! end;
! end if;
! declare
! Naming_Id : constant Package_Id :=
! Util.Value_Of (Name_Naming, Data.Decl.Packages);
! Naming : Package_Element;
! begin
! -- If there is a package Naming, we will put in Data.Naming
! -- what is in this package Naming.
! if Naming_Id /= No_Package then
! Naming := Packages.Table (Naming_Id);
! if Current_Verbosity = High then
! Write_Line ("Checking ""Naming"" for Ada.");
end if;
! declare
! Bodies : constant Array_Element_Id :=
! Util.Value_Of
! (Name_Implementation, Naming.Decl.Arrays);
! Specifications : constant Array_Element_Id :=
! Util.Value_Of
! (Name_Specification, Naming.Decl.Arrays);
! begin
! if Bodies /= No_Array_Element then
! -- We have elements in the array Body_Part
! if Current_Verbosity = High then
! Write_Line ("Found Bodies.");
! end if;
! Data.Naming.Bodies := Bodies;
! Check_Unit_Names (Bodies);
! else
! if Current_Verbosity = High then
! Write_Line ("No Bodies.");
! end if;
! end if;
! if Specifications /= No_Array_Element then
! -- We have elements in the array Specification
! if Current_Verbosity = High then
! Write_Line ("Found Specifications.");
! end if;
! Data.Naming.Specifications := Specifications;
! Check_Unit_Names (Specifications);
! else
! if Current_Verbosity = High then
! Write_Line ("No Specifications.");
! end if;
! end if;
! end;
! -- We are now checking if variables Dot_Replacement, Casing,
! -- Specification_Append, Body_Append and/or Separate_Append
! -- exist.
! -- For each variable, if it does not exist, we do nothing,
! -- because we already have the default.
! -- Check Dot_Replacement
declare
! Dot_Replacement : constant Variable_Value :=
! Util.Value_Of
! (Name_Dot_Replacement,
! Naming.Decl.Attributes);
begin
! pragma Assert (Dot_Replacement.Kind = Single,
! "Dot_Replacement is not a single string");
! if not Dot_Replacement.Default then
! String_To_Name_Buffer (Dot_Replacement.Value);
! if Name_Len = 0 then
! Error_Msg ("Dot_Replacement cannot be empty",
! Dot_Replacement.Location);
! else
! Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
! Data.Naming.Dot_Replacement := Name_Find;
! Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
! end if;
!
end if;
! end;
! if Current_Verbosity = High then
! Write_Str (" Dot_Replacement = """);
! Write_Str (Get_Name_String (Data.Naming.Dot_Replacement));
! Write_Char ('"');
! Write_Eol;
! end if;
! -- Check Casing
! declare
! Casing_String : constant Variable_Value :=
! Util.Value_Of (Name_Casing, Naming.Decl.Attributes);
! begin
! pragma Assert (Casing_String.Kind = Single,
! "Dot_Replacement is not a single string");
! if not Casing_String.Default then
! declare
! Casing_Image : constant String :=
! Get_Name_String (Casing_String.Value);
! begin
! declare
! Casing : constant Casing_Type :=
! Value (Casing_Image);
! begin
! Data.Naming.Casing := Casing;
! end;
! exception
! when Constraint_Error =>
! if Casing_Image'Length = 0 then
! Error_Msg ("Casing cannot be an empty string",
! Casing_String.Location);
!
! else
! Name_Len := Casing_Image'Length;
! Name_Buffer (1 .. Name_Len) := Casing_Image;
! Error_Msg_Name_1 := Name_Find;
! Error_Msg
! ("{ is not a correct Casing",
! Casing_String.Location);
! end if;
! end;
! end if;
! end;
if Current_Verbosity = High then
! Write_Str (" Casing = ");
! Write_Str (Image (Data.Naming.Casing));
! Write_Char ('.');
! Write_Eol;
end if;
! -- Check Specification_Suffix
declare
! Ada_Spec_Suffix : constant Name_Id :=
! Prj.Util.Value_Of
! (Index => Name_Ada,
! In_Array => Data.Naming.Specification_Suffix);
begin
! if Ada_Spec_Suffix /= No_Name then
! Data.Naming.Current_Spec_Suffix := Ada_Spec_Suffix;
else
! Data.Naming.Current_Spec_Suffix := Ada_Default_Spec_Suffix;
end if;
end;
if Current_Verbosity = High then
! Write_Str (" Specification_Suffix = """);
! Write_Str (Get_Name_String (Data.Naming.Current_Spec_Suffix));
! Write_Char ('"');
! Write_Eol;
! end if;
! -- Check Implementation_Suffix
! declare
! Ada_Impl_Suffix : constant Name_Id :=
! Prj.Util.Value_Of
! (Index => Name_Ada,
! In_Array => Data.Naming.Implementation_Suffix);
! begin
! if Ada_Impl_Suffix /= No_Name then
! Data.Naming.Current_Impl_Suffix := Ada_Impl_Suffix;
! else
! Data.Naming.Current_Impl_Suffix := Ada_Default_Impl_Suffix;
end if;
! end;
if Current_Verbosity = High then
! Write_Str (" Implementation_Suffix = """);
! Write_Str (Get_Name_String (Data.Naming.Current_Impl_Suffix));
! Write_Char ('"');
! Write_Eol;
end if;
! -- Check Separate_Suffix
! declare
! Ada_Sep_Suffix : constant Variable_Value :=
! Prj.Util.Value_Of
! (Variable_Name => Name_Separate_Suffix,
! In_Variables => Naming.Decl.Attributes);
! begin
! if Ada_Sep_Suffix = Nil_Variable_Value then
! Data.Naming.Separate_Suffix :=
! Data.Naming.Current_Impl_Suffix;
! else
! String_To_Name_Buffer (Ada_Sep_Suffix.Value);
! if Name_Len = 0 then
! Error_Msg ("Separate_Suffix cannot be empty",
! Ada_Sep_Suffix.Location);
! else
! Data.Naming.Separate_Suffix := Name_Find;
! Data.Naming.Sep_Suffix_Loc := Ada_Sep_Suffix.Location;
! end if;
! end if;
! end;
! if Current_Verbosity = High then
! Write_Str (" Separate_Suffix = """);
! Write_Str (Get_Name_String (Data.Naming.Separate_Suffix));
! Write_Char ('"');
! Write_Eol;
! end if;
! -- Check if Data.Naming is valid
! Check_Ada_Naming_Scheme (Data.Naming);
! else
! Data.Naming.Current_Spec_Suffix := Ada_Default_Spec_Suffix;
! Data.Naming.Current_Impl_Suffix := Ada_Default_Impl_Suffix;
! Data.Naming.Separate_Suffix := Ada_Default_Impl_Suffix;
end if;
end;
! -- If we have source directories, then find the sources
! if Data.Sources_Present then
! if Data.Source_Dirs = Nil_String then
! Data.Sources_Present := False;
! else
! declare
! Sources : constant Variable_Value :=
! Util.Value_Of
! (Name_Source_Files,
! Data.Decl.Attributes);
!
! Source_List_File : constant Variable_Value :=
! Util.Value_Of
! (Name_Source_List_File,
! Data.Decl.Attributes);
! begin
! pragma Assert
! (Sources.Kind = List,
! "Source_Files is not a list");
! pragma Assert
! (Source_List_File.Kind = Single,
! "Source_List_File is not a single string");
! if not Sources.Default then
! if not Source_List_File.Default then
! Error_Msg
! ("?both variables source_files and " &
! "source_list_file are present",
! Source_List_File.Location);
! end if;
! -- Sources is a list of file names
! declare
! Current_Source : String_List_Id := Nil_String;
! Current : String_List_Id := Sources.Values;
! Element : String_Element;
! begin
! Data.Sources_Present := Current /= Nil_String;
! while Current /= Nil_String loop
! Element := String_Elements.Table (Current);
! String_To_Name_Buffer (Element.Value);
! declare
! File_Name : constant String :=
! Name_Buffer (1 .. Name_Len);
! begin
! Get_Path_Name_And_Record_Source
! (File_Name => File_Name,
! Location => Element.Location,
! Current_Source => Current_Source);
! Current := Element.Next;
! end;
! end loop;
! end;
! -- No source_files specified.
! -- We check Source_List_File has been specified.
! elsif not Source_List_File.Default then
! -- Source_List_File is the name of the file
! -- that contains the source file names
! declare
! Source_File_Path_Name : constant String :=
! Path_Name_Of
! (Source_List_File.Value,
! Data.Directory);
! begin
! if Source_File_Path_Name'Length = 0 then
! String_To_Name_Buffer (Source_List_File.Value);
! Error_Msg_Name_1 := Name_Find;
! Error_Msg
! ("file with sources { does not exist",
! Source_List_File.Location);
!
! else
! Get_Sources_From_File
! (Source_File_Path_Name,
! Source_List_File.Location);
! end if;
! end;
else
! -- Neither Source_Files nor Source_List_File has been
! -- specified.
! -- Find all the files that satisfy
! -- the naming scheme in all the source directories.
!
! Find_Sources;
end if;
end;
! end if;
! end if;
! Projects.Table (Project) := Data;
! end Ada_Check;
! --------------------
! -- Check_Ada_Name --
! --------------------
! procedure Check_Ada_Name
! (Name : Name_Id;
! Unit : out Name_Id)
! is
! The_Name : String := Get_Name_String (Name);
! Need_Letter : Boolean := True;
! Last_Underscore : Boolean := False;
! OK : Boolean := The_Name'Length > 0;
! begin
! for Index in The_Name'Range loop
! if Need_Letter then
! -- We need a letter (at the beginning, and following a dot),
! -- but we don't have one.
! if Is_Letter (The_Name (Index)) then
! Need_Letter := False;
! else
! OK := False;
+ if Current_Verbosity = High then
+ Write_Int (Types.Int (Index));
+ Write_Str (": '");
+ Write_Char (The_Name (Index));
+ Write_Line ("' is not a letter.");
end if;
! exit;
! end if;
!
! elsif Last_Underscore
! and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
! then
! -- Two underscores are illegal, and a dot cannot follow
! -- an underscore.
!
! OK := False;
if Current_Verbosity = High then
! Write_Int (Types.Int (Index));
! Write_Str (": '");
! Write_Char (The_Name (Index));
! Write_Line ("' is illegal here.");
end if;
! exit;
! elsif The_Name (Index) = '.' then
! -- We need a letter after a dot
! Need_Letter := True;
! elsif The_Name (Index) = '_' then
! Last_Underscore := True;
! else
! -- We need an letter or a digit
! Last_Underscore := False;
! if not Is_Alphanumeric (The_Name (Index)) then
! OK := False;
! if Current_Verbosity = High then
! Write_Int (Types.Int (Index));
! Write_Str (": '");
! Write_Char (The_Name (Index));
! Write_Line ("' is not alphanumeric.");
end if;
! exit;
end if;
! end if;
! end loop;
! -- We cannot end with an underscore or a dot
! OK := OK and then not Need_Letter and then not Last_Underscore;
! if OK then
! Unit := Name;
! else
! -- We signal a problem with No_Name
! Unit := No_Name;
! end if;
! end Check_Ada_Name;
! -------------------------
! -- Check_Naming_Scheme --
! -------------------------
! procedure Check_Ada_Naming_Scheme (Naming : Naming_Data) is
! begin
! -- Only check if we are not using the standard naming scheme
! if Naming /= Standard_Naming_Data then
! declare
! Dot_Replacement : constant String :=
! Get_Name_String
! (Naming.Dot_Replacement);
! Specification_Suffix : constant String :=
! Get_Name_String
! (Naming.Current_Spec_Suffix);
! Implementation_Suffix : constant String :=
! Get_Name_String
! (Naming.Current_Impl_Suffix);
! Separate_Suffix : constant String :=
! Get_Name_String
! (Naming.Separate_Suffix);
! begin
! -- Dot_Replacement cannot
! -- - be empty
! -- - start or end with an alphanumeric
! -- - be a single '_'
! -- - start with an '_' followed by an alphanumeric
! -- - contain a '.' except if it is "."
! if Dot_Replacement'Length = 0
! or else Is_Alphanumeric
! (Dot_Replacement (Dot_Replacement'First))
! or else Is_Alphanumeric
! (Dot_Replacement (Dot_Replacement'Last))
! or else (Dot_Replacement (Dot_Replacement'First) = '_'
! and then
! (Dot_Replacement'Length = 1
! or else
! Is_Alphanumeric
! (Dot_Replacement (Dot_Replacement'First + 1))))
! or else (Dot_Replacement'Length > 1
! and then
! Index (Source => Dot_Replacement,
! Pattern => ".") /= 0)
! then
! Error_Msg
! ('"' & Dot_Replacement &
! """ is illegal for Dot_Replacement.",
! Naming.Dot_Repl_Loc);
end if;
! -- Suffixs cannot
! -- - be empty
! -- - start with an alphanumeric
! -- - start with an '_' followed by an alphanumeric
! if Is_Illegal_Append (Specification_Suffix) then
! Error_Msg
! ('"' & Specification_Suffix &
! """ is illegal for Specification_Suffix.",
! Naming.Spec_Suffix_Loc);
! end if;
! if Is_Illegal_Append (Implementation_Suffix) then
! Error_Msg
! ('"' & Implementation_Suffix &
! """ is illegal for Implementation_Suffix.",
! Naming.Impl_Suffix_Loc);
! end if;
! if Implementation_Suffix /= Separate_Suffix then
! if Is_Illegal_Append (Separate_Suffix) then
Error_Msg
! ('"' & Separate_Suffix &
! """ is illegal for Separate_Append.",
! Naming.Sep_Suffix_Loc);
end if;
! end if;
! -- Specification_Suffix cannot have the same termination as
! -- Implementation_Suffix or Separate_Suffix
! if Specification_Suffix'Length <= Implementation_Suffix'Length
! and then
! Implementation_Suffix (Implementation_Suffix'Last -
! Specification_Suffix'Length + 1 ..
! Implementation_Suffix'Last) = Specification_Suffix
! then
! Error_Msg
! ("Implementation_Suffix (""" &
! Implementation_Suffix &
! """) cannot end with" &
! "Specification_Suffix (""" &
! Specification_Suffix & """).",
! Naming.Impl_Suffix_Loc);
! end if;
! if Specification_Suffix'Length <= Separate_Suffix'Length
! and then
! Separate_Suffix
! (Separate_Suffix'Last - Specification_Suffix'Length + 1
! ..
! Separate_Suffix'Last) = Specification_Suffix
! then
! Error_Msg
! ("Separate_Suffix (""" &
! Separate_Suffix &
! """) cannot end with" &
! " Specification_Suffix (""" &
! Specification_Suffix & """).",
! Naming.Sep_Suffix_Loc);
end if;
end;
end if;
! end Check_Ada_Naming_Scheme;
---------------
-- Error_Msg --
***************
*** 1770,1776 ****
begin
-- Check if the end of the file name is Specification_Append
! Get_Name_String (Naming.Specification_Append);
if File'Length > Name_Len
and then File (Last - Name_Len + 1 .. Last) =
--- 1242,1248 ----
begin
-- Check if the end of the file name is Specification_Append
! Get_Name_String (Naming.Current_Spec_Suffix);
if File'Length > Name_Len
and then File (Last - Name_Len + 1 .. Last) =
***************
*** 1781,1963 ****
Unit_Kind := Specification;
Last := Last - Name_Len;
if Current_Verbosity = High then
! Write_Str (" Specification: ");
! Write_Line (File (First .. Last));
end if;
else
! Get_Name_String (Naming.Body_Append);
! -- Check if the end of the file name is Body_Append
! if File'Length > Name_Len
! and then File (Last - Name_Len + 1 .. Last) =
! Name_Buffer (1 .. Name_Len)
! then
! -- We have a body
! Unit_Kind := Body_Part;
! Last := Last - Name_Len;
! if Current_Verbosity = High then
! Write_Str (" Body: ");
! Write_Line (File (First .. Last));
end if;
! elsif Naming.Separate_Append /= Naming.Body_Append then
! Get_Name_String (Naming.Separate_Append);
! -- Check if the end of the file name is Separate_Append
! if File'Length > Name_Len
! and then File (Last - Name_Len + 1 .. Last) =
! Name_Buffer (1 .. Name_Len)
! then
! -- We have a separate (a body)
! Unit_Kind := Body_Part;
! Last := Last - Name_Len;
! if Current_Verbosity = High then
! Write_Str (" Separate: ");
! Write_Line (File (First .. Last));
end if;
! else
! Last := 0;
end if;
-
- else
- Last := 0;
end if;
end if;
-
- if Last = 0 then
-
- -- This is not a source file
! Unit_Name := No_Name;
! Unit_Kind := Specification;
if Current_Verbosity = High then
! Write_Line (" Not a valid file name.");
end if;
! return;
! end if;
! Get_Name_String (Naming.Dot_Replacement);
! if Name_Buffer (1 .. Name_Len) /= "." then
! -- If Dot_Replacement is not a single dot,
! -- then there should not be any dot in the name.
! for Index in First .. Last loop
! if File (Index) = '.' then
! if Current_Verbosity = High then
! Write_Line
! (" Not a valid file name (some dot not replaced).");
! end if;
! Unit_Name := No_Name;
! return;
! end if;
! end loop;
! -- Replace the substring Dot_Replacement with dots
! declare
! Index : Positive := First;
! begin
! while Index <= Last - Name_Len + 1 loop
! if File (Index .. Index + Name_Len - 1) =
! Name_Buffer (1 .. Name_Len)
! then
! File (Index) := '.';
! if Name_Len > 1 and then Index < Last then
! File (Index + 1 .. Last - Name_Len + 1) :=
! File (Index + Name_Len .. Last);
! end if;
! Last := Last - Name_Len + 1;
end if;
! Index := Index + 1;
! end loop;
! end;
end if;
!
! -- Check if the casing is right
! declare
! Src : String := File (First .. Last);
! begin
! case Naming.Casing is
! when All_Lower_Case =>
! Fixed.Translate
! (Source => Src,
! Mapping => Lower_Case_Map);
! when All_Upper_Case =>
! Fixed.Translate
! (Source => Src,
! Mapping => Upper_Case_Map);
! when Mixed_Case | Unknown =>
! null;
! end case;
! if Src /= File (First .. Last) then
! if Current_Verbosity = High then
! Write_Line (" Not a valid file name (casing).");
! end if;
! Unit_Name := No_Name;
! return;
end if;
! -- We put the name in lower case
! Fixed.Translate
! (Source => Src,
! Mapping => Lower_Case_Map);
! if Current_Verbosity = High then
! Write_Str (" ");
! Write_Line (Src);
! end if;
! Name_Len := Src'Length;
! Name_Buffer (1 .. Name_Len) := Src;
! -- Now, we check if this name is a valid unit name
! Check_Naming_Scheme (Name => Name_Find, Unit => Unit_Name);
! end;
! end;
! end Get_Unit;
! -----------------------
! -- Is_Illegal_Append --
! -----------------------
! function Is_Illegal_Append (This : String) return Boolean is
! begin
! return This'Length = 0
! or else Is_Alphanumeric (This (This'First))
! or else (This'Length >= 2
! and then This (This'First) = '_'
! and then Is_Alphanumeric (This (This'First + 1)));
! end Is_Illegal_Append;
----------------------
-- Locate_Directory --
--- 1253,2087 ----
Unit_Kind := Specification;
Last := Last - Name_Len;
+ if Current_Verbosity = High then
+ Write_Str (" Specification: ");
+ Write_Line (File (First .. Last));
+ end if;
+
+ else
+ Get_Name_String (Naming.Current_Impl_Suffix);
+
+ -- Check if the end of the file name is Body_Append
+
+ if File'Length > Name_Len
+ and then File (Last - Name_Len + 1 .. Last) =
+ Name_Buffer (1 .. Name_Len)
+ then
+ -- We have a body
+
+ Unit_Kind := Body_Part;
+ Last := Last - Name_Len;
+
+ if Current_Verbosity = High then
+ Write_Str (" Body: ");
+ Write_Line (File (First .. Last));
+ end if;
+
+ elsif Naming.Separate_Suffix /= Naming.Current_Spec_Suffix then
+ Get_Name_String (Naming.Separate_Suffix);
+
+ -- Check if the end of the file name is Separate_Append
+
+ if File'Length > Name_Len
+ and then File (Last - Name_Len + 1 .. Last) =
+ Name_Buffer (1 .. Name_Len)
+ then
+ -- We have a separate (a body)
+
+ Unit_Kind := Body_Part;
+ Last := Last - Name_Len;
+
+ if Current_Verbosity = High then
+ Write_Str (" Separate: ");
+ Write_Line (File (First .. Last));
+ end if;
+
+ else
+ Last := 0;
+ end if;
+
+ else
+ Last := 0;
+ end if;
+ end if;
+
+ if Last = 0 then
+
+ -- This is not a source file
+
+ Unit_Name := No_Name;
+ Unit_Kind := Specification;
+
+ if Current_Verbosity = High then
+ Write_Line (" Not a valid file name.");
+ end if;
+
+ return;
+ end if;
+
+ Get_Name_String (Naming.Dot_Replacement);
+
+ if Name_Buffer (1 .. Name_Len) /= "." then
+
+ -- If Dot_Replacement is not a single dot,
+ -- then there should not be any dot in the name.
+
+ for Index in First .. Last loop
+ if File (Index) = '.' then
+ if Current_Verbosity = High then
+ Write_Line
+ (" Not a valid file name (some dot not replaced).");
+ end if;
+
+ Unit_Name := No_Name;
+ return;
+
+ end if;
+ end loop;
+
+ -- Replace the substring Dot_Replacement with dots
+
+ declare
+ Index : Positive := First;
+
+ begin
+ while Index <= Last - Name_Len + 1 loop
+
+ if File (Index .. Index + Name_Len - 1) =
+ Name_Buffer (1 .. Name_Len)
+ then
+ File (Index) := '.';
+
+ if Name_Len > 1 and then Index < Last then
+ File (Index + 1 .. Last - Name_Len + 1) :=
+ File (Index + Name_Len .. Last);
+ end if;
+
+ Last := Last - Name_Len + 1;
+ end if;
+
+ Index := Index + 1;
+ end loop;
+ end;
+ end if;
+
+ -- Check if the casing is right
+
+ declare
+ Src : String := File (First .. Last);
+
+ begin
+ case Naming.Casing is
+ when All_Lower_Case =>
+ Fixed.Translate
+ (Source => Src,
+ Mapping => Lower_Case_Map);
+
+ when All_Upper_Case =>
+ Fixed.Translate
+ (Source => Src,
+ Mapping => Upper_Case_Map);
+
+ when Mixed_Case | Unknown =>
+ null;
+ end case;
+
+ if Src /= File (First .. Last) then
+ if Current_Verbosity = High then
+ Write_Line (" Not a valid file name (casing).");
+ end if;
+
+ Unit_Name := No_Name;
+ return;
+ end if;
+
+ -- We put the name in lower case
+
+ Fixed.Translate
+ (Source => Src,
+ Mapping => Lower_Case_Map);
+
+ if Current_Verbosity = High then
+ Write_Str (" ");
+ Write_Line (Src);
+ end if;
+
+ Name_Len := Src'Length;
+ Name_Buffer (1 .. Name_Len) := Src;
+
+ -- Now, we check if this name is a valid unit name
+
+ Check_Ada_Name (Name => Name_Find, Unit => Unit_Name);
+ end;
+
+ end;
+
+ end Get_Unit;
+
+ -----------------------
+ -- Is_Illegal_Append --
+ -----------------------
+
+ function Is_Illegal_Append (This : String) return Boolean is
+ begin
+ return This'Length = 0
+ or else Is_Alphanumeric (This (This'First))
+ or else (This'Length >= 2
+ and then This (This'First) = '_'
+ and then Is_Alphanumeric (This (This'First + 1)));
+ end Is_Illegal_Append;
+
+ --------------------------------
+ -- Language_Independent_Check --
+ --------------------------------
+
+ procedure Language_Independent_Check
+ (Project : Project_Id;
+ Report_Error : Put_Line_Access)
+ is
+ Last_Source_Dir : String_List_Id := Nil_String;
+ Data : Project_Data := Projects.Table (Project);
+
+ procedure Find_Source_Dirs (From : String_Id; Location : Source_Ptr);
+ -- Find one or several source directories, and add them
+ -- to the list of source directories of the project.
+
+ ----------------------
+ -- Find_Source_Dirs --
+ ----------------------
+
+ procedure Find_Source_Dirs (From : String_Id; Location : Source_Ptr) is
+
+ Directory : String (1 .. Integer (String_Length (From)));
+ Directory_Id : Name_Id;
+ Element : String_Element;
+
+ procedure Recursive_Find_Dirs (Path : String_Id);
+ -- Find all the subdirectories (recursively) of Path
+ -- and add them to the list of source directories
+ -- of the project.
+
+ -------------------------
+ -- Recursive_Find_Dirs --
+ -------------------------
+
+ procedure Recursive_Find_Dirs (Path : String_Id) is
+ Dir : Dir_Type;
+ Name : String (1 .. 250);
+ Last : Natural;
+ The_Path : String := Get_Name_String (Path) & Dir_Sep;
+
+ The_Path_Last : Positive := The_Path'Last;
+
+ begin
+ if The_Path'Length > 1
+ and then
+ (The_Path (The_Path_Last - 1) = Dir_Sep
+ or else The_Path (The_Path_Last - 1) = '/')
+ then
+ The_Path_Last := The_Path_Last - 1;
+ end if;
+
+ if Current_Verbosity = High then
+ Write_Str (" ");
+ Write_Line (The_Path (The_Path'First .. The_Path_Last));
+ end if;
+
+ String_Elements.Increment_Last;
+ Element :=
+ (Value => Path,
+ Location => No_Location,
+ Next => Nil_String);
+
+ -- Case of first source directory
+
+ if Last_Source_Dir = Nil_String then
+ Data.Source_Dirs := String_Elements.Last;
+
+ -- Here we already have source directories.
+
+ else
+ -- Link the previous last to the new one
+
+ String_Elements.Table (Last_Source_Dir).Next :=
+ String_Elements.Last;
+ end if;
+
+ -- And register this source directory as the new last
+
+ Last_Source_Dir := String_Elements.Last;
+ String_Elements.Table (Last_Source_Dir) := Element;
+
+ -- Now look for subdirectories
+
+ Open (Dir, The_Path (The_Path'First .. The_Path_Last));
+
+ loop
+ Read (Dir, Name, Last);
+ exit when Last = 0;
+
+ if Current_Verbosity = High then
+ Write_Str (" Checking ");
+ Write_Line (Name (1 .. Last));
+ end if;
+
+ if Name (1 .. Last) /= "."
+ and then Name (1 .. Last) /= ".."
+ then
+ -- Avoid . and ..
+
+ declare
+ Path_Name : constant String :=
+ The_Path (The_Path'First .. The_Path_Last) &
+ Name (1 .. Last);
+
+ begin
+ if Is_Directory (Path_Name) then
+
+ -- We have found a new subdirectory,
+ -- register it and find its own subdirectories.
+
+ Start_String;
+ Store_String_Chars (Path_Name);
+ Recursive_Find_Dirs (End_String);
+ end if;
+ end;
+ end if;
+ end loop;
+
+ Close (Dir);
+
+ exception
+ when Directory_Error =>
+ null;
+ end Recursive_Find_Dirs;
+
+ -- Start of processing for Find_Source_Dirs
+
+ begin
+ if Current_Verbosity = High then
+ Write_Str ("Find_Source_Dirs (""");
+ end if;
+
+ String_To_Name_Buffer (From);
+ Directory := Name_Buffer (1 .. Name_Len);
+ Directory_Id := Name_Find;
+
+ if Current_Verbosity = High then
+ Write_Str (Directory);
+ Write_Line (""")");
+ end if;
+
+ -- First, check if we are looking for a directory tree,
+ -- indicated by "/**" at the end.
+
+ if Directory'Length >= 3
+ and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
+ and then (Directory (Directory'Last - 2) = '/'
+ or else
+ Directory (Directory'Last - 2) = Dir_Sep)
+ then
+ Name_Len := Directory'Length - 3;
+
+ if Name_Len = 0 then
+ -- This is the case of "/**": all directories
+ -- in the file system.
+
+ Name_Len := 1;
+ Name_Buffer (1) := Directory (Directory'First);
+
+ else
+ Name_Buffer (1 .. Name_Len) :=
+ Directory (Directory'First .. Directory'Last - 3);
+ end if;
+
+ if Current_Verbosity = High then
+ Write_Str ("Looking for all subdirectories of """);
+ Write_Str (Name_Buffer (1 .. Name_Len));
+ Write_Line ("""");
+ end if;
+
+ declare
+ Base_Dir : constant Name_Id := Name_Find;
+ Root : constant Name_Id :=
+ Locate_Directory (Base_Dir, Data.Directory);
+
+ begin
+ if Root = No_Name then
+ Error_Msg_Name_1 := Base_Dir;
+ if Location = No_Location then
+ Error_Msg ("{ is not a valid directory.", Data.Location);
+ else
+ Error_Msg ("{ is not a valid directory.", Location);
+ end if;
+
+ else
+ -- We have an existing directory,
+ -- we register it and all of its subdirectories.
+
+ if Current_Verbosity = High then
+ Write_Line ("Looking for source directories:");
+ end if;
+
+ Start_String;
+ Store_String_Chars (Get_Name_String (Root));
+ Recursive_Find_Dirs (End_String);
+
+ if Current_Verbosity = High then
+ Write_Line ("End of looking for source directories.");
+ end if;
+ end if;
+ end;
+
+ -- We have a single directory
+
+ else
+ declare
+ Path_Name : constant Name_Id :=
+ Locate_Directory (Directory_Id, Data.Directory);
+
+ begin
+ if Path_Name = No_Name then
+ Error_Msg_Name_1 := Directory_Id;
+ if Location = No_Location then
+ Error_Msg ("{ is not a valid directory", Data.Location);
+ else
+ Error_Msg ("{ is not a valid directory", Location);
+ end if;
+ else
+
+ -- As it is an existing directory, we add it to
+ -- the list of directories.
+
+ String_Elements.Increment_Last;
+ Start_String;
+ Store_String_Chars (Get_Name_String (Path_Name));
+ Element.Value := End_String;
+
+ if Last_Source_Dir = Nil_String then
+
+ -- This is the first source directory
+
+ Data.Source_Dirs := String_Elements.Last;
+
+ else
+ -- We already have source directories,
+ -- link the previous last to the new one.
+
+ String_Elements.Table (Last_Source_Dir).Next :=
+ String_Elements.Last;
+ end if;
+
+ -- And register this source directory as the new last
+
+ Last_Source_Dir := String_Elements.Last;
+ String_Elements.Table (Last_Source_Dir) := Element;
+ end if;
+ end;
+ end if;
+ end Find_Source_Dirs;
+
+ -- Start of processing for Language_Independent_Check
+
+ begin
+
+ if Data.Language_Independent_Checked then
+ return;
+ end if;
+
+ Data.Language_Independent_Checked := True;
+
+ Error_Report := Report_Error;
+
+ if Current_Verbosity = High then
+ Write_Line ("Starting to look for directories");
+ end if;
+
+ -- Let's check the object directory
+
+ declare
+ Object_Dir : Variable_Value :=
+ Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes);
+
+ begin
+ pragma Assert (Object_Dir.Kind = Single,
+ "Object_Dir is not a single string");
+
+ -- We set the object directory to its default
+
+ Data.Object_Directory := Data.Directory;
+
+ if not String_Equal (Object_Dir.Value, Empty_String) then
+
+ String_To_Name_Buffer (Object_Dir.Value);
+
+ if Name_Len = 0 then
+ Error_Msg ("Object_Dir cannot be empty",
+ Object_Dir.Location);
+
+ else
+ -- We check that the specified object directory
+ -- does exist.
+
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+
+ declare
+ Dir_Id : constant Name_Id := Name_Find;
+
+ begin
+ Data.Object_Directory :=
+ Locate_Directory (Dir_Id, Data.Directory);
+
+ if Data.Object_Directory = No_Name then
+ Error_Msg_Name_1 := Dir_Id;
+ Error_Msg
+ ("the object directory { cannot be found",
+ Data.Location);
+ end if;
+ end;
+ end if;
+ end if;
+ end;
+
+ if Current_Verbosity = High then
+ if Data.Object_Directory = No_Name then
+ Write_Line ("No object directory");
+ else
+ Write_Str ("Object directory: """);
+ Write_Str (Get_Name_String (Data.Object_Directory));
+ Write_Line ("""");
+ end if;
+ end if;
+
+ -- Look for the source directories
+
+ declare
+ Source_Dirs : Variable_Value :=
+ Util.Value_Of (Name_Source_Dirs, Data.Decl.Attributes);
+
+ begin
+
+ if Current_Verbosity = High then
+ Write_Line ("Starting to look for source directories");
+ end if;
+
+ pragma Assert (Source_Dirs.Kind = List,
+ "Source_Dirs is not a list");
+
+ if Source_Dirs.Default then
+
+ -- No Source_Dirs specified: the single source directory
+ -- is the one containing the project file
+
+ String_Elements.Increment_Last;
+ Data.Source_Dirs := String_Elements.Last;
+ Start_String;
+ Store_String_Chars (Get_Name_String (Data.Directory));
+ String_Elements.Table (Data.Source_Dirs) :=
+ (Value => End_String,
+ Location => No_Location,
+ Next => Nil_String);
+
+ if Current_Verbosity = High then
+ Write_Line ("(Undefined) Single object directory:");
+ Write_Str (" """);
+ Write_Str (Get_Name_String (Data.Directory));
+ Write_Line ("""");
+ end if;
+
+ elsif Source_Dirs.Values = Nil_String then
+
+ -- If Source_Dirs is an empty string list, this means
+ -- that this project contains no source.
+
+ if Data.Object_Directory = Data.Directory then
+ Data.Object_Directory := No_Name;
+ end if;
+
+ Data.Source_Dirs := Nil_String;
+ Data.Sources_Present := False;
+
+ else
+ declare
+ Source_Dir : String_List_Id := Source_Dirs.Values;
+ Element : String_Element;
+
+ begin
+ -- We will find the source directories for each
+ -- element of the list
+
+ while Source_Dir /= Nil_String loop
+ Element := String_Elements.Table (Source_Dir);
+ Find_Source_Dirs (Element.Value, Element.Location);
+ Source_Dir := Element.Next;
+ end loop;
+ end;
+ end if;
+
+ if Current_Verbosity = High then
+ Write_Line ("Puting source directories in canonical cases");
+ end if;
+
+ declare
+ Current : String_List_Id := Data.Source_Dirs;
+ Element : String_Element;
+
+ begin
+ while Current /= Nil_String loop
+ Element := String_Elements.Table (Current);
+ if Element.Value /= No_String then
+ String_To_Name_Buffer (Element.Value);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Start_String;
+ Store_String_Chars (Name_Buffer (1 .. Name_Len));
+ Element.Value := End_String;
+ String_Elements.Table (Current) := Element;
+ end if;
+
+ Current := Element.Next;
+ end loop;
+ end;
+ end;
+
+ -- Library Dir, Name, Version and Kind
+
+ declare
+ Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
+
+ Lib_Dir : Prj.Variable_Value :=
+ Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes);
+
+ Lib_Name : Prj.Variable_Value :=
+ Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes);
+
+ Lib_Version : Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Version, Attributes);
+
+ The_Lib_Kind : Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Kind, Attributes);
+
+ begin
+ pragma Assert (Lib_Dir.Kind = Single);
+
+ if Lib_Dir.Value = Empty_String then
+
if Current_Verbosity = High then
! Write_Line ("No library directory");
end if;
else
! -- Find path name, check that it is a directory
! Stringt.String_To_Name_Buffer (Lib_Dir.Value);
! declare
! Dir_Id : constant Name_Id := Name_Find;
! begin
! Data.Library_Dir :=
! Locate_Directory (Dir_Id, Data.Directory);
! if Data.Library_Dir = No_Name then
! Error_Msg ("not an existing directory",
! Lib_Dir.Location);
!
! elsif Data.Library_Dir = Data.Object_Directory then
! Error_Msg
! ("library directory cannot be the same " &
! "as object directory",
! Lib_Dir.Location);
! Data.Library_Dir := No_Name;
!
! else
! if Current_Verbosity = High then
! Write_Str ("Library directory =""");
! Write_Str (Get_Name_String (Data.Library_Dir));
! Write_Line ("""");
! end if;
end if;
+ end;
+ end if;
! pragma Assert (Lib_Name.Kind = Single);
! if Lib_Name.Value = Empty_String then
! if Current_Verbosity = High then
! Write_Line ("No library name");
! end if;
! else
! Stringt.String_To_Name_Buffer (Lib_Name.Value);
! if not Is_Letter (Name_Buffer (1)) then
! Error_Msg ("must start with a letter",
! Lib_Name.Location);
! else
! Data.Library_Name := Name_Find;
!
! for Index in 2 .. Name_Len loop
! if not Is_Alphanumeric (Name_Buffer (Index)) then
! Data.Library_Name := No_Name;
! Error_Msg ("only letters and digits are allowed",
! Lib_Name.Location);
! exit;
end if;
+ end loop;
! if Data.Library_Name /= No_Name
! and then Current_Verbosity = High then
! Write_Str ("Library name = """);
! Write_Str (Get_Name_String (Data.Library_Name));
! Write_Line ("""");
end if;
end if;
end if;
! Data.Library :=
! Data.Library_Dir /= No_Name
! and then
! Data.Library_Name /= No_Name;
+ if Data.Library then
if Current_Verbosity = High then
! Write_Line ("This is a library project file");
end if;
! pragma Assert (Lib_Version.Kind = Single);
! if Lib_Version.Value = Empty_String then
! if Current_Verbosity = High then
! Write_Line ("No library version specified");
! end if;
! else
! Stringt.String_To_Name_Buffer (Lib_Version.Value);
! Data.Lib_Internal_Name := Name_Find;
! end if;
! pragma Assert (The_Lib_Kind.Kind = Single);
! if The_Lib_Kind.Value = Empty_String then
! if Current_Verbosity = High then
! Write_Line ("No library kind specified");
! end if;
! else
! Stringt.String_To_Name_Buffer (The_Lib_Kind.Value);
! declare
! Kind_Name : constant String :=
! To_Lower (Name_Buffer (1 .. Name_Len));
! OK : Boolean := True;
! begin
! if Kind_Name = "static" then
! Data.Library_Kind := Static;
! elsif Kind_Name = "dynamic" then
! Data.Library_Kind := Dynamic;
! elsif Kind_Name = "relocatable" then
! Data.Library_Kind := Relocatable;
! else
! Error_Msg
! ("illegal value for Library_Kind",
! The_Lib_Kind.Location);
! OK := False;
end if;
! if Current_Verbosity = High and then OK then
! Write_Str ("Library kind = ");
! Write_Line (Kind_Name);
! end if;
! end;
! end if;
end if;
! end;
! if Current_Verbosity = High then
! Show_Source_Dirs (Project);
! end if;
! declare
! Naming_Id : constant Package_Id :=
! Util.Value_Of (Name_Naming, Data.Decl.Packages);
! Naming : Package_Element;
! begin
! -- If there is a package Naming, we will put in Data.Naming
! -- what is in this package Naming.
! if Naming_Id /= No_Package then
! Naming := Packages.Table (Naming_Id);
! if Current_Verbosity = High then
! Write_Line ("Checking ""Naming"".");
end if;
! -- Check Specification_Suffix
! Data.Naming.Specification_Suffix := Util.Value_Of
! (Name_Specification_Suffix,
! Naming.Decl.Arrays);
! declare
! Current : Array_Element_Id := Data.Naming.Specification_Suffix;
! Element : Array_Element;
! begin
! while Current /= No_Array_Element loop
! Element := Array_Elements.Table (Current);
! String_To_Name_Buffer (Element.Value.Value);
! if Name_Len = 0 then
! Error_Msg
! ("Specification_Suffix cannot be empty",
! Element.Value.Location);
! end if;
! Array_Elements.Table (Current) := Element;
! Current := Element.Next;
! end loop;
! end;
! -- Check Implementation_Suffix
! Data.Naming.Implementation_Suffix := Util.Value_Of
! (Name_Implementation_Suffix,
! Naming.Decl.Arrays);
! declare
! Current : Array_Element_Id := Data.Naming.Implementation_Suffix;
! Element : Array_Element;
! begin
! while Current /= No_Array_Element loop
! Element := Array_Elements.Table (Current);
! String_To_Name_Buffer (Element.Value.Value);
!
! if Name_Len = 0 then
! Error_Msg
! ("Implementation_Suffix cannot be empty",
! Element.Value.Location);
! end if;
!
! Array_Elements.Table (Current) := Element;
! Current := Element.Next;
! end loop;
! end;
!
! end if;
! end;
!
! Projects.Table (Project) := Data;
! end Language_Independent_Check;
----------------------
-- Locate_Directory --
***************
*** 2077,2083 ****
Path_Name : Name_Id;
Project : Project_Id;
Data : in out Project_Data;
- Error_If_Invalid : Boolean;
Location : Source_Ptr;
Current_Source : in out String_List_Id)
is
--- 2201,2206 ----
***************
*** 2101,2118 ****
-- Error_If_Invalid is true.
if Unit_Name = No_Name then
! if Error_If_Invalid then
! Error_Msg_Name_1 := File_Name;
! Error_Msg
! ("{ is not a valid source file name",
! Location);
!
! else
! if Current_Verbosity = High then
! Write_Str (" """);
! Write_Str (Get_Name_String (File_Name));
! Write_Line (""" is not a valid source file name (ignored).");
! end if;
end if;
else
--- 2224,2233 ----
-- Error_If_Invalid is true.
if Unit_Name = No_Name then
! if Current_Verbosity = High then
! Write_Str (" """);
! Write_Str (Get_Name_String (File_Name));
! Write_Line (""" is not a valid source file name (ignored).");
end if;
else
*** prj-nmsc.ads 2001/08/03 19:03:54 1.3
--- prj-nmsc.ads 2001/10/05 15:15:46 1.4
***************
*** 31,42 ****
private package Prj.Nmsc is
! procedure Check_Naming_Scheme
(Project : Project_Id;
Report_Error : Put_Line_Access);
! -- Check that the Naming Scheme of a project is legal. Find the
! -- object directory, the source directories, and the source files.
! -- Check the source files against the Naming Scheme.
-- If Report_Error is null , use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error.
--- 31,51 ----
private package Prj.Nmsc is
! procedure Ada_Check
(Project : Project_Id;
Report_Error : Put_Line_Access);
! -- Call Language_Independent_Check.
! -- Check the naming scheme for Ada.
! -- Find the Ada source files if any.
! -- If Report_Error is null , use the standard error reporting mechanism
! -- (Errout). Otherwise, report errors using Report_Error.
!
! procedure Language_Independent_Check
! (Project : Project_Id;
! Report_Error : Put_Line_Access);
! -- Check the object directory and the source directories.
! -- Check the library attributes, including the library directory if any.
! -- Get the set of specification and implementation suffixs, if any.
-- If Report_Error is null , use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error.
*** prj-proc.adb 2001/09/06 04:43:48 1.16
--- prj-proc.adb 2001/10/05 15:15:52 1.17
***************
*** 27,32 ****
--- 27,33 ----
------------------------------------------------------------------------------
with Errout; use Errout;
+ with GNAT.Case_Util;
with Namet; use Namet;
with Opt;
with Output; use Output;
***************
*** 1015,1020 ****
--- 1016,1025 ----
String_To_Name_Buffer
(Associative_Array_Index_Of (Current_Item));
+ if Case_Insensitive (Current_Item) then
+ GNAT.Case_Util.To_Lower (Name_Buffer (1 .. Name_Len));
+ end if;
+
declare
The_Array : Array_Id;
***************
*** 1260,1266 ****
Write_Line ("""");
end if;
! Prj.Nmsc.Check_Naming_Scheme (Project, Error_Report);
end if;
end Recursive_Check;
--- 1265,1271 ----
Write_Line ("""");
end if;
! Prj.Nmsc.Ada_Check (Project, Error_Report);
end if;
end Recursive_Check;
*** prj-tree.adb 2001/08/10 20:41:02 1.7
--- prj-tree.adb 2001/10/05 15:15:57 1.8
***************
*** 48,53 ****
--- 48,66 ----
return Project_Nodes.Table (Node).Value;
end Associative_Array_Index_Of;
+ ----------------------
+ -- Case_Insensitive --
+ ----------------------
+
+ function Case_Insensitive (Node : Project_Node_Id) return Boolean is
+ begin
+ pragma Assert
+ (Node /= Empty_Node
+ and then
+ (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
+ return Project_Nodes.Table (Node).Case_Insensitive;
+ end Case_Insensitive;
+
--------------------------------
-- Case_Variable_Reference_Of --
--------------------------------
***************
*** 108,126 ****
begin
Project_Nodes.Increment_Last;
Project_Nodes.Table (Project_Nodes.Last) :=
! (Kind => Of_Kind,
! Location => No_Location,
! Directory => No_Name,
! Expr_Kind => And_Expr_Kind,
! Variables => Empty_Node,
! Packages => Empty_Node,
! Pkg_Id => Empty_Package,
! Name => No_Name,
! Path_Name => No_Name,
! Value => No_String,
! Field1 => Empty_Node,
! Field2 => Empty_Node,
! Field3 => Empty_Node);
return Project_Nodes.Last;
end Default_Project_Node;
--- 121,140 ----
begin
Project_Nodes.Increment_Last;
Project_Nodes.Table (Project_Nodes.Last) :=
! (Kind => Of_Kind,
! Location => No_Location,
! Directory => No_Name,
! Expr_Kind => And_Expr_Kind,
! Variables => Empty_Node,
! Packages => Empty_Node,
! Pkg_Id => Empty_Package,
! Name => No_Name,
! Path_Name => No_Name,
! Value => No_String,
! Field1 => Empty_Node,
! Field2 => Empty_Node,
! Field3 => Empty_Node,
! Case_Insensitive => False);
return Project_Nodes.Last;
end Default_Project_Node;
***************
*** 722,727 ****
--- 736,757 ----
Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
Project_Nodes.Table (Node).Value := To;
end Set_Associative_Array_Index_Of;
+
+ --------------------------
+ -- Set_Case_Insensitive --
+ --------------------------
+
+ procedure Set_Case_Insensitive
+ (Node : Project_Node_Id;
+ To : Boolean)
+ is
+ begin
+ pragma Assert
+ (Node /= Empty_Node
+ and then
+ Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
+ Project_Nodes.Table (Node).Case_Insensitive := To;
+ end Set_Case_Insensitive;
------------------------------------
-- Set_Case_Variable_Reference_Of --
*** prj-tree.ads 2001/08/10 20:41:08 1.9
--- prj-tree.ads 2001/10/05 15:16:02 1.10
***************
*** 306,311 ****
--- 306,314 ----
return Project_Node_Id;
-- Only valid for N_Case_Item nodes
+ function Case_Insensitive (Node : Project_Node_Id) return Boolean;
+ -- Only valid for N_Attribute_Declaration nodes
+
--------------------
-- Set Procedures --
--------------------
***************
*** 480,485 ****
--- 483,492 ----
(Node : Project_Node_Id;
To : Project_Node_Id);
+ procedure Set_Case_Insensitive
+ (Node : Project_Node_Id;
+ To : Boolean);
+
-------------------------------
-- Restricted Access Section --
-------------------------------
***************
*** 491,532 ****
type Project_Node_Record is record
! Kind : Project_Node_Kind;
! Location : Source_Ptr := No_Location;
! Directory : Name_Id := No_Name;
-- Only for N_Project
! Expr_Kind : Variable_Kind := Undefined;
-- See below for what Project_Node_Kind it is used
! Variables : Variable_Node_Id := Empty_Node;
-- First variable in a project or a package
! Packages : Package_Declaration_Id := Empty_Node;
-- First package declaration in a project
! Pkg_Id : Package_Node_Id := Empty_Package;
-- Only use in Package_Declaration
! Name : Name_Id := No_Name;
-- See below for what Project_Node_Kind it is used
! Path_Name : Name_Id := No_Name;
-- See below for what Project_Node_Kind it is used
! Value : String_Id := No_String;
-- See below for what Project_Node_Kind it is used
! Field1 : Project_Node_Id := Empty_Node;
-- See below the meaning for each Project_Node_Kind
! Field2 : Project_Node_Id := Empty_Node;
-- See below the meaning for each Project_Node_Kind
! Field3 : Project_Node_Id := Empty_Node;
-- See below the meaning for each Project_Node_Kind
end record;
--- 498,543 ----
type Project_Node_Record is record
! Kind : Project_Node_Kind;
! Location : Source_Ptr := No_Location;
! Directory : Name_Id := No_Name;
-- Only for N_Project
! Expr_Kind : Variable_Kind := Undefined;
-- See below for what Project_Node_Kind it is used
! Variables : Variable_Node_Id := Empty_Node;
-- First variable in a project or a package
! Packages : Package_Declaration_Id := Empty_Node;
-- First package declaration in a project
! Pkg_Id : Package_Node_Id := Empty_Package;
-- Only use in Package_Declaration
! Name : Name_Id := No_Name;
-- See below for what Project_Node_Kind it is used
! Path_Name : Name_Id := No_Name;
-- See below for what Project_Node_Kind it is used
! Value : String_Id := No_String;
-- See below for what Project_Node_Kind it is used
! Field1 : Project_Node_Id := Empty_Node;
-- See below the meaning for each Project_Node_Kind
! Field2 : Project_Node_Id := Empty_Node;
-- See below the meaning for each Project_Node_Kind
! Field3 : Project_Node_Id := Empty_Node;
-- See below the meaning for each Project_Node_Kind
+
+ Case_Insensitive : Boolean := False;
+ -- Indicates, for an associative array attribute, that the
+ -- index is case insensitive.
end record;
*** prj-util.adb 2001/09/28 09:57:09 1.10
--- prj-util.adb 2001/10/05 15:16:07 1.11
***************
*** 188,193 ****
--- 188,209 ----
--------------
function Value_Of
+ (Variable : Variable_Value;
+ Default : String)
+ return String is
+ begin
+ if Variable.Kind /= Single
+ or else Variable.Default
+ or else Variable.Value = No_String then
+ return Default;
+
+ else
+ String_To_Name_Buffer (Variable.Value);
+ return Name_Buffer (1 .. Name_Len);
+ end if;
+ end Value_Of;
+
+ function Value_Of
(Index : Name_Id;
In_Array : Array_Element_Id)
return Name_Id
Index: prj-util.ads
===================================================================
RCS file: /nile.c/cvs/Dev/gnat/prj-util.ads,v
retrieving revision 1.6
retrieving revision 1.7
diff -c -r1.6 -r1.7
*** prj-util.ads 2001/09/25 00:41:10 1.6
--- prj-util.ads 2001/09/28 09:54:10 1.7
***************
*** 53,59 ****
(Name : Name_Id;
Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id)
! return Variable_Value;
-- In a specific package,
-- - if there exists an array Variable_Or_Array_Name with an index
-- Name, returns the corresponding component,
--- 53,59 ----
(Name : Name_Id;
Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id)
! return Variable_Value;
-- In a specific package,
-- - if there exists an array Variable_Or_Array_Name with an index
-- Name, returns the corresponding component,
***************
*** 76,116 ****
(Name : Name_Id;
In_Arrays : Array_Id)
return Array_Element_Id;
! -- Returns a specified array in an array list.
! -- Returns No_Array_Element if In_Arrays is null or if Name is not the
! -- name of an array in In_Arrays.
! -- Assumption: Name is in lower case.
function Value_Of
(Name : Name_Id;
In_Packages : Package_Id)
return Package_Id;
! -- Returns a specified package in a package list.
! -- Returns No_Package if In_Packages is null or if Name is not the
! -- name of a package in Package_List.
! -- Assumption: Name is in lower case.
function Value_Of
(Variable_Name : Name_Id;
In_Variables : Variable_Id)
return Variable_Value;
! -- Returns a specified variable in a variable list.
! -- Returns null if In_Variables is null or if Variable_Name
! -- is not the name of a variable in In_Variables.
! -- Assumption: Variable_Name is in lower case.
procedure Write_Str
(S : String;
Max_Length : Positive;
Separator : Character);
! -- Output string S using Output.Write_Str.
! -- If S is too long to fit in one line of Max_Length, cut it in
! -- several lines, using Separator as the last character of each line,
! -- if possible.
type Text_File is limited private;
! -- Represents a text file.
! -- Default is invalid text file.
function Is_Valid (File : Text_File) return Boolean;
-- Returns True if File designates an open text file that
--- 76,111 ----
(Name : Name_Id;
In_Arrays : Array_Id)
return Array_Element_Id;
! -- Returns a specified array in an array list. Returns No_Array_Element
! -- if In_Arrays is null or if Name is not the name of an array in
! -- In_Arrays. The caller must ensure that Name is in lower case.
function Value_Of
(Name : Name_Id;
In_Packages : Package_Id)
return Package_Id;
! -- Returns a specified package in a package list. Returns No_Package
! -- if In_Packages is null or if Name is not the name of a package in
! -- Package_List. The caller must ensure that Name is in lower case.
function Value_Of
(Variable_Name : Name_Id;
In_Variables : Variable_Id)
return Variable_Value;
! -- Returns a specified variable in a variable list. Returns null if
! -- In_Variables is null or if Variable_Name-- is not the name of a
! -- variable in In_Variables. Caller must ensure that Name is lower case.
procedure Write_Str
(S : String;
Max_Length : Positive;
Separator : Character);
! -- Output string S using Output.Write_Str. If S is too long to fit in
! -- one line of Max_Length, cut it in several lines, using Separator as
! -- the last character of each line, if possible.
type Text_File is limited private;
! -- Represents a text file. Default is invalid text file.
function Is_Valid (File : Text_File) return Boolean;
-- Returns True if File designates an open text file that
*** prj-util.ads 2001/09/28 09:54:10 1.7
--- prj-util.ads 2001/10/05 15:16:11 1.8
***************
*** 34,39 ****
--- 34,46 ----
package Prj.Util is
function Value_Of
+ (Variable : Variable_Value;
+ Default : String)
+ return String;
+ -- Get the value of a single string variable. If Variable is
+ -- Nil_Variable_Value, is a string list or is defaulted, return Default.
+
+ function Value_Of
(Index : Name_Id;
In_Array : Array_Element_Id)
return Name_Id;
***************
*** 93,99 ****
In_Variables : Variable_Id)
return Variable_Value;
-- Returns a specified variable in a variable list. Returns null if
! -- In_Variables is null or if Variable_Name-- is not the name of a
-- variable in In_Variables. Caller must ensure that Name is lower case.
procedure Write_Str
--- 100,106 ----
In_Variables : Variable_Id)
return Variable_Value;
-- Returns a specified variable in a variable list. Returns null if
! -- In_Variables is null or if Variable_Name is not the name of a
-- variable in In_Variables. Caller must ensure that Name is lower case.
procedure Write_Str
*** prj.adb 2001/09/09 00:40:14 1.16
--- prj.adb 2001/10/05 15:16:17 1.17
***************
*** 30,36 ****
with Errout; use Errout;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Namet; use Namet;
- with Osint; use Osint;
with Prj.Attr;
with Prj.Com;
with Prj.Env;
--- 30,35 ----
***************
*** 42,49 ****
package body Prj is
! The_Empty_String : String_Id;
subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
The_Casing_Images : array (Known_Casing) of String_Access :=
--- 41,51 ----
package body Prj is
! The_Empty_String : String_Id;
+ Default_Ada_Spec_Suffix : Name_Id := No_Name;
+ Default_Ada_Impl_Suffix : Name_Id := No_Name;
+
subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
The_Casing_Images : array (Known_Casing) of String_Access :=
***************
*** 55,106 ****
Standard_Dot_Replacement : constant Name_Id :=
First_Name_Id + Character'Pos ('-');
- Standard_Specification_Append : Name_Id;
- Standard_Body_Append : Name_Id;
Std_Naming_Data : Naming_Data :=
! (Dot_Replacement => Standard_Dot_Replacement,
! Dot_Repl_Loc => No_Location,
! Casing => All_Lower_Case,
! Specification_Append => No_Name,
! Spec_Append_Loc => No_Location,
! Body_Append => No_Name,
! Body_Append_Loc => No_Location,
! Separate_Append => No_Name,
! Sep_Append_Loc => No_Location,
! Specifications => No_Array_Element,
! Bodies => No_Array_Element);
!
! Project_Empty : Project_Data :=
! (First_Referred_By => No_Project,
! Name => No_Name,
! Path_Name => No_Name,
! Location => No_Location,
! Directory => No_Name,
! File_Name => No_Name,
! Library => False,
! Library_Dir => No_Name,
! Library_Name => No_Name,
! Library_Kind => Static,
! Lib_Internal_Name => No_Name,
! Lib_Elaboration => False,
! Sources => Nil_String,
! Source_Dirs => Nil_String,
! Object_Directory => No_Name,
! Modifies => No_Project,
! Modified_By => No_Project,
! Naming => Std_Naming_Data,
! Decl => No_Declarations,
! Imported_Projects => Empty_Project_List,
! Include_Path => null,
! Objects_Path => null,
! Config_File_Name => No_Name,
! Config_File_Temp => False,
! Config_Checked => False,
! Checked => False,
! Seen => False,
! Flag1 => False,
! Flag2 => False);
-------------------
-- Empty_Project --
--- 57,130 ----
Standard_Dot_Replacement : constant Name_Id :=
First_Name_Id + Character'Pos ('-');
Std_Naming_Data : Naming_Data :=
! (Current_Language => No_Name,
! Dot_Replacement => Standard_Dot_Replacement,
! Dot_Repl_Loc => No_Location,
! Casing => All_Lower_Case,
! Specification_Suffix => No_Array_Element,
! Current_Spec_Suffix => No_Name,
! Spec_Suffix_Loc => No_Location,
! Implementation_Suffix => No_Array_Element,
! Current_Impl_Suffix => No_Name,
! Impl_Suffix_Loc => No_Location,
! Separate_Suffix => No_Name,
! Sep_Suffix_Loc => No_Location,
! Specifications => No_Array_Element,
! Bodies => No_Array_Element,
! Specification_Exceptions => No_Array_Element,
! Implementation_Exceptions => No_Array_Element);
!
! Project_Empty : constant Project_Data :=
! (First_Referred_By => No_Project,
! Name => No_Name,
! Path_Name => No_Name,
! Location => No_Location,
! Directory => No_Name,
! Library => False,
! Library_Dir => No_Name,
! Library_Name => No_Name,
! Library_Kind => Static,
! Lib_Internal_Name => No_Name,
! Lib_Elaboration => False,
! Sources_Present => True,
! Sources => Nil_String,
! Source_Dirs => Nil_String,
! Object_Directory => No_Name,
! Modifies => No_Project,
! Modified_By => No_Project,
! Naming => Std_Naming_Data,
! Decl => No_Declarations,
! Imported_Projects => Empty_Project_List,
! Include_Path => null,
! Objects_Path => null,
! Config_File_Name => No_Name,
! Config_File_Temp => False,
! Config_Checked => False,
! Language_Independent_Checked => False,
! Checked => False,
! Seen => False,
! Flag1 => False,
! Flag2 => False);
!
! -----------------------------
! -- Ada_Default_Spec_Suffix --
! -----------------------------
!
! function Ada_Default_Spec_Suffix return Name_Id is
! begin
! return Default_Ada_Spec_Suffix;
! end Ada_Default_Spec_Suffix;
!
! -----------------------------
! -- Ada_Default_Impl_Suffix --
! -----------------------------
!
! function Ada_Default_Impl_Suffix return Name_Id is
! begin
! return Default_Ada_Impl_Suffix;
! end Ada_Default_Impl_Suffix;
-------------------
-- Empty_Project --
***************
*** 192,206 ****
The_Empty_String := End_String;
Name_Len := 4;
Name_Buffer (1 .. 4) := ".ads";
! Canonical_Case_File_Name (Name_Buffer (1 .. 4));
! Standard_Specification_Append := Name_Find;
! Name_Buffer (4) := 'b';
! Canonical_Case_File_Name (Name_Buffer (1 .. 4));
! Standard_Body_Append := Name_Find;
! Std_Naming_Data.Specification_Append := Standard_Specification_Append;
! Std_Naming_Data.Body_Append := Standard_Body_Append;
! Std_Naming_Data.Separate_Append := Standard_Body_Append;
! Project_Empty.Naming := Std_Naming_Data;
Prj.Env.Initialize;
Prj.Attr.Initialize;
Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
--- 216,228 ----
The_Empty_String := End_String;
Name_Len := 4;
Name_Buffer (1 .. 4) := ".ads";
! Default_Ada_Spec_Suffix := Name_Find;
! Name_Len := 4;
! Name_Buffer (1 .. 4) := ".adb";
! Default_Ada_Impl_Suffix := Name_Find;
! Std_Naming_Data.Current_Spec_Suffix := Default_Ada_Spec_Suffix;
! Std_Naming_Data.Current_Impl_Suffix := Default_Ada_Impl_Suffix;
! Std_Naming_Data.Separate_Suffix := Default_Ada_Impl_Suffix;
Prj.Env.Initialize;
Prj.Attr.Initialize;
Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
***************
*** 236,244 ****
begin
return Left.Dot_Replacement = Right.Dot_Replacement
and then Left.Casing = Right.Casing
! and then Left.Specification_Append = Right.Specification_Append
! and then Left.Body_Append = Right.Body_Append
! and then Left.Separate_Append = Right.Separate_Append;
end Same_Naming_Scheme;
----------
--- 258,266 ----
begin
return Left.Dot_Replacement = Right.Dot_Replacement
and then Left.Casing = Right.Casing
! and then Left.Current_Spec_Suffix = Right.Current_Spec_Suffix
! and then Left.Current_Impl_Suffix = Right.Current_Impl_Suffix
! and then Left.Separate_Suffix = Right.Separate_Suffix;
end Same_Naming_Scheme;
----------
*** prj.ads 2001/09/09 00:42:22 1.18
--- prj.ads 2001/10/05 15:18:22 1.19
***************
*** 195,241 ****
-- Raises Constraint_Error if not a Casing_Type image.
type Naming_Data is record
! Dot_Replacement : Name_Id := No_Name;
! -- The string to replace '.' in the source file name.
! Dot_Repl_Loc : Source_Ptr := No_Location;
-- The position in the project file source where
-- Dot_Replacement is defined.
! Casing : Casing_Type := All_Lower_Case;
! -- The casing of the source file name.
! Specification_Append : Name_Id := No_Name;
-- The string to append to the unit name for the
-- source file name of a specification.
! Spec_Append_Loc : Source_Ptr := No_Location;
-- The position in the project file source where
! -- Specification_Append is defined.
! Body_Append : Name_Id := No_Name;
-- The string to append to the unit name for the
-- source file name of a body.
! Body_Append_Loc : Source_Ptr := No_Location;
-- The position in the project file source where
! -- Body_Append is defined.
! Separate_Append : Name_Id := No_Name;
-- The string to append to the unit name for the
! -- source file name of a subunit.
! Sep_Append_Loc : Source_Ptr := No_Location;
-- The position in the project file source where
! -- Separate_Append is defined.
! Specifications : Array_Element_Id := No_Array_Element;
-- An associative array mapping individual specifications
! -- to source file names.
! Bodies : Array_Element_Id := No_Array_Element;
-- An associative array mapping individual bodies
! -- to source file names.
end record;
-- A naming scheme.
--- 195,260 ----
-- Raises Constraint_Error if not a Casing_Type image.
type Naming_Data is record
! Current_Language : Name_Id := No_Name;
! -- The programming language being currently considered
! Dot_Replacement : Name_Id := No_Name;
! -- The string to replace '.' in the source file name (for Ada).
!
! Dot_Repl_Loc : Source_Ptr := No_Location;
-- The position in the project file source where
-- Dot_Replacement is defined.
! Casing : Casing_Type := All_Lower_Case;
! -- The casing of the source file name (for Ada).
! Specification_Suffix : Array_Element_Id := No_Array_Element;
-- The string to append to the unit name for the
-- source file name of a specification.
+ -- Indexed by the programming language.
+
+ Current_Spec_Suffix : Name_Id := No_Name;
+ -- The specification suffix of the current programming language
! Spec_Suffix_Loc : Source_Ptr := No_Location;
-- The position in the project file source where
! -- Current_Spec_Suffix is defined.
! Implementation_Suffix : Array_Element_Id := No_Array_Element;
-- The string to append to the unit name for the
-- source file name of a body.
+ -- Indexed by the programming language.
+
+ Current_Impl_Suffix : Name_Id := No_Name;
+ -- The implementation suffix of the current programming language
! Impl_Suffix_Loc : Source_Ptr := No_Location;
-- The position in the project file source where
! -- Current_Impl_Suffix is defined.
! Separate_Suffix : Name_Id := No_Name;
-- The string to append to the unit name for the
! -- source file name of an Ada subunit.
! Sep_Suffix_Loc : Source_Ptr := No_Location;
-- The position in the project file source where
! -- Separate_Suffix is defined.
!
! Specifications : Array_Element_Id := No_Array_Element;
! -- An associative array mapping individual specifications
! -- to source file names. Specific to Ada.
!
! Bodies : Array_Element_Id := No_Array_Element;
! -- An associative array mapping individual bodies
! -- to source file names. Specific to Ada.
! Specification_Exceptions : Array_Element_Id := No_Array_Element;
-- An associative array mapping individual specifications
! -- to source file names. Indexed by the programming language name.
! Implementation_Exceptions : Array_Element_Id := No_Array_Element;
-- An associative array mapping individual bodies
! -- to source file names. Indexed by the programming language name.
end record;
-- A naming scheme.
***************
*** 278,365 ****
First_Referred_By : Project_Id := No_Project;
-- The project, if any, that was the first to be known
-- as importing or modifying this project.
Name : Name_Id := No_Name;
-- The name of the project.
Path_Name : Name_Id := No_Name;
-- The path name of the project file.
Location : Source_Ptr := No_Location;
-- The location in the project file source of the
-- reserved word project.
Directory : Name_Id := No_Name;
-- The directory where the project file resides.
!
! File_Name : Name_Id := No_Name;
! -- The file name of the project file.
Library : Boolean := False;
! -- True if this is a library project
Library_Dir : Name_Id := No_Name;
-- If a library project, directory where resides the library
Library_Name : Name_Id := No_Name;
-- If a library project, name of the library
Library_Kind : Lib_Kind := Static;
-- If a library project, kind of library
Lib_Internal_Name : Name_Id := No_Name;
-- If a library project, internal name store inside the library
Lib_Elaboration : Boolean := False;
-- If a library project, indicate if <lib>init and <lib>final
-- procedures need to be defined.
Sources : String_List_Id := Nil_String;
-- The list of all the source file names.
Source_Dirs : String_List_Id := Nil_String;
-- The list of all the source directories.
Object_Directory : Name_Id := No_Name;
-- The object directory of this project file.
Modifies : Project_Id := No_Project;
-- The reference of the project file, if any, that this
-- project file modifies.
Modified_By : Project_Id := No_Project;
-- The reference of the project file, if any, that
-- modifies this project file.
Naming : Naming_Data := Standard_Naming_Data;
-- The naming scheme of this project file.
Decl : Declarations := No_Declarations;
-- The declarations (variables, attributes and packages)
-- of this project file.
Imported_Projects : Project_List := Empty_Project_List;
-- The list of all directly imported projects, if any.
Include_Path : String_Access := null;
-- The cached value of ADA_INCLUDE_PATH for this project file.
Objects_Path : String_Access := null;
-- The cached value of ADA_OBJECTS_PATH for this project file.
Config_File_Name : Name_Id := No_Name;
-- The name of the configuration pragmas file, if any.
Config_File_Temp : Boolean := False;
-- An indication that the configuration pragmas file is
-- a temporary file that must be deleted at the end.
Config_Checked : Boolean := False;
! -- A flag to avoid checking repetively the configuration pragmas file.
Checked : Boolean := False;
! -- A flag to avoid checking repetively the naming scheme of
-- this project file.
-- Various flags that are used in an ad hoc manner
--- 297,418 ----
First_Referred_By : Project_Id := No_Project;
-- The project, if any, that was the first to be known
-- as importing or modifying this project.
+ -- Set by Prj.Proc.Process.
Name : Name_Id := No_Name;
-- The name of the project.
+ -- Set by Prj.Proc.Process.
Path_Name : Name_Id := No_Name;
-- The path name of the project file.
+ -- Set by Prj.Proc.Process.
Location : Source_Ptr := No_Location;
-- The location in the project file source of the
-- reserved word project.
+ -- Set by Prj.Proc.Process.
Directory : Name_Id := No_Name;
-- The directory where the project file resides.
! -- Set by Prj.Proc.Process.
Library : Boolean := False;
! -- True if this is a library project.
! -- Set by Prj.Nmsc.Check_Naming_Scheme.
Library_Dir : Name_Id := No_Name;
-- If a library project, directory where resides the library
+ -- Set by Prj.Nmsc.Check_Naming_Scheme.
Library_Name : Name_Id := No_Name;
-- If a library project, name of the library
+ -- Set by Prj.Nmsc.Check_Naming_Scheme.
Library_Kind : Lib_Kind := Static;
-- If a library project, kind of library
+ -- Set by Prj.Nmsc.Check_Naming_Scheme.
Lib_Internal_Name : Name_Id := No_Name;
-- If a library project, internal name store inside the library
+ -- Set by Prj.Nmsc.Check_Naming_Scheme.
Lib_Elaboration : Boolean := False;
-- If a library project, indicate if <lib>init and <lib>final
-- procedures need to be defined.
+ -- Set by Prj.Nmsc.Check_Naming_Scheme.
+
+ Sources_Present : Boolean := True;
+ -- A flag that indicates if there are sources in this project file.
+ -- There are no sources if 1) Source_Dirs is specified as an
+ -- empty list, 2) Source_Files is specified as an empty list, or
+ -- 3) the current language is not in the list of the specified
+ -- Languages.
Sources : String_List_Id := Nil_String;
-- The list of all the source file names.
+ -- Set by Prj.Nmsc.Check_Naming_Scheme.
Source_Dirs : String_List_Id := Nil_String;
-- The list of all the source directories.
+ -- Set by Prj.Nmsc.Check_Naming_Scheme.
Object_Directory : Name_Id := No_Name;
-- The object directory of this project file.
+ -- Set by Prj.Nmsc.Check_Naming_Scheme.
Modifies : Project_Id := No_Project;
-- The reference of the project file, if any, that this
-- project file modifies.
+ -- Set by Prj.Proc.Process.
Modified_By : Project_Id := No_Project;
-- The reference of the project file, if any, that
-- modifies this project file.
+ -- Set by Prj.Proc.Process.
Naming : Naming_Data := Standard_Naming_Data;
-- The naming scheme of this project file.
+ -- Set by Prj.Nmsc.Check_Naming_Scheme.
Decl : Declarations := No_Declarations;
-- The declarations (variables, attributes and packages)
-- of this project file.
+ -- Set by Prj.Proc.Process.
Imported_Projects : Project_List := Empty_Project_List;
-- The list of all directly imported projects, if any.
+ -- Set by Prj.Proc.Process.
Include_Path : String_Access := null;
-- The cached value of ADA_INCLUDE_PATH for this project file.
+ -- Set by gnatmake (prj.Env.Set_Ada_Paths).
Objects_Path : String_Access := null;
-- The cached value of ADA_OBJECTS_PATH for this project file.
+ -- Set by gnatmake (prj.Env.Set_Ada_Paths).
Config_File_Name : Name_Id := No_Name;
-- The name of the configuration pragmas file, if any.
+ -- Set by gnatmage (Prj.Env.Create_Config_Pragmas_File).
Config_File_Temp : Boolean := False;
-- An indication that the configuration pragmas file is
-- a temporary file that must be deleted at the end.
+ -- Set by gnatmage (Prj.Env.Create_Config_Pragmas_File).
Config_Checked : Boolean := False;
! -- A flag to avoid checking repetitively the configuration pragmas file.
! -- Set by gnatmage (Prj.Env.Create_Config_Pragmas_File).
+ Language_Independent_Checked : Boolean := False;
+ -- A flag that indicates that the project file has been checked
+ -- for language independent features: Object_Directory,
+ -- Source_Directories, Library, non empty Naming Suffixs.
+
Checked : Boolean := False;
! -- A flag to avoid checking repetitively the naming scheme of
-- this project file.
+ -- Set by Prj.Nmsc.Check_Naming_Scheme.
-- Various flags that are used in an ad hoc manner
***************
*** 407,412 ****
--- 460,469 ----
-- imports B, directly or indirectly, Action will be called for A before
-- it is called for B. With_State may be used by Action to choose a
-- behavior or to report some global result.
+
+ function Ada_Default_Spec_Suffix return Name_Id;
+
+ function Ada_Default_Impl_Suffix return Name_Id;
private
*** snames.ads 2001/09/30 05:20:46 1.210
--- snames.ads 2001/10/05 15:18:26 1.211
***************
*** 862,868 ****
Name_Project : constant Name_Id := N + 523;
Name_Modifying : constant Name_Id := N + 524;
! -- Name_External is already declared as N + 243
-- Names used in GNAT Project Files
--- 862,868 ----
Name_Project : constant Name_Id := N + 523;
Name_Modifying : constant Name_Id := N + 524;
! -- Name_External is already declared as N + 161
-- Names used in GNAT Project Files
***************
*** 870,901 ****
Name_Object_Dir : constant Name_Id := N + 526;
Name_Source_Dirs : constant Name_Id := N + 527;
Name_Specification : constant Name_Id := N + 528;
! Name_Body_Part : constant Name_Id := N + 529;
! Name_Specification_Append : constant Name_Id := N + 530;
! Name_Body_Append : constant Name_Id := N + 531;
! Name_Separate_Append : constant Name_Id := N + 532;
! Name_Source_Files : constant Name_Id := N + 533;
! Name_Source_List_File : constant Name_Id := N + 534;
! Name_Switches : constant Name_Id := N + 535;
! Name_Library_Dir : constant Name_Id := N + 536;
! Name_Library_Name : constant Name_Id := N + 537;
! Name_Library_Kind : constant Name_Id := N + 538;
! Name_Library_Version : constant Name_Id := N + 539;
! Name_Library_Elaboration : constant Name_Id := N + 540;
! Name_Gnatmake : constant Name_Id := N + 541;
! Name_Gnatls : constant Name_Id := N + 542;
! Name_Gnatxref : constant Name_Id := N + 543;
! Name_Gnatfind : constant Name_Id := N + 544;
! Name_Gnatbind : constant Name_Id := N + 545;
! Name_Gnatlink : constant Name_Id := N + 546;
! Name_Compiler : constant Name_Id := N + 547;
! Name_Binder : constant Name_Id := N + 548;
! Name_Linker : constant Name_Id := N + 549;
-- Mark last defined name for consistency check in Snames body
! Last_Predefined_Name : constant Name_Id := N + 549;
subtype Any_Operator_Name is Name_Id range
First_Operator_Name .. Last_Operator_Name;
--- 870,903 ----
Name_Object_Dir : constant Name_Id := N + 526;
Name_Source_Dirs : constant Name_Id := N + 527;
Name_Specification : constant Name_Id := N + 528;
! Name_Implementation : constant Name_Id := N + 529;
! Name_Specification_Exceptions : constant Name_Id := N + 530;
! Name_Implementation_Exceptions : constant Name_Id := N + 531;
! Name_Specification_Suffix : constant Name_Id := N + 532;
! Name_Implementation_Suffix : constant Name_Id := N + 533;
! Name_Separate_Suffix : constant Name_Id := N + 534;
! Name_Source_Files : constant Name_Id := N + 535;
! Name_Source_List_File : constant Name_Id := N + 536;
! Name_Default_Switches : constant Name_Id := N + 537;
! Name_Switches : constant Name_Id := N + 538;
! Name_Library_Dir : constant Name_Id := N + 539;
! Name_Library_Name : constant Name_Id := N + 540;
! Name_Library_Kind : constant Name_Id := N + 541;
! Name_Library_Version : constant Name_Id := N + 542;
! Name_Library_Elaboration : constant Name_Id := N + 543;
! Name_Languages : constant Name_Id := N + 544;
! Name_Builder : constant Name_Id := N + 545;
! Name_Gnatls : constant Name_Id := N + 546;
! Name_Cross_Reference : constant Name_Id := N + 547;
! Name_Finder : constant Name_Id := N + 548;
! Name_Binder : constant Name_Id := N + 549;
! Name_Linker : constant Name_Id := N + 550;
! Name_Compiler : constant Name_Id := N + 551;
-- Mark last defined name for consistency check in Snames body
! Last_Predefined_Name : constant Name_Id := N + 551;
subtype Any_Operator_Name is Name_Id range
First_Operator_Name .. Last_Operator_Name;
*** prj.ads 2001/10/05 15:18:22 1.19
--- prj.ads 2001/10/05 16:15:42 1.20
***************
*** 462,469 ****
--- 462,471 ----
-- behavior or to report some global result.
function Ada_Default_Spec_Suffix return Name_Id;
+ -- Comment needed ???
function Ada_Default_Impl_Suffix return Name_Id;
+ -- Comment needed ???
private
*** prj.ads 2001/10/05 16:15:42 1.20
--- prj.ads 2001/10/05 16:50:06 1.21
***************
*** 456,471 ****
(By : Project_Id;
With_State : in out State);
-- Call Action for each project imported directly or indirectly by project
! -- By.-- Action is called according to the order of importation: if A
-- imports B, directly or indirectly, Action will be called for A before
-- it is called for B. With_State may be used by Action to choose a
-- behavior or to report some global result.
function Ada_Default_Spec_Suffix return Name_Id;
! -- Comment needed ???
function Ada_Default_Impl_Suffix return Name_Id;
! -- Comment needed ???
private
--- 456,473 ----
(By : Project_Id;
With_State : in out State);
-- Call Action for each project imported directly or indirectly by project
! -- By. Action is called according to the order of importation: if A
-- imports B, directly or indirectly, Action will be called for A before
-- it is called for B. With_State may be used by Action to choose a
-- behavior or to report some global result.
function Ada_Default_Spec_Suffix return Name_Id;
! -- Return the Name_Id for the standard GNAT suffix for Ada spec source
! -- file name ".ads".
function Ada_Default_Impl_Suffix return Name_Id;
! -- Return the Name_Id for the standard GNAT suffix for Ada body source
! -- file name ".adb".
private
Index: prj-nmsc.adb
===================================================================
RCS file: /nile.c/cvs/Dev/gnat/prj-nmsc.adb,v
retrieving revision 1.26
retrieving revision 1.27
diff -c -r1.26 -r1.27
*** prj-nmsc.adb 2001/10/05 15:15:41 1.26
--- prj-nmsc.adb 2001/10/05 16:25:33 1.27
***************
*** 26,47 ****
-- --
------------------------------------------------------------------------------
! with Ada.Characters.Handling; use Ada.Characters.Handling;
! with Ada.Strings; use Ada.Strings;
! with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
! with Errout; use Errout;
! with GNAT.Case_Util; use GNAT.Case_Util;
! with GNAT.Directory_Operations; use GNAT.Directory_Operations;
! with GNAT.OS_Lib; use GNAT.OS_Lib;
! with Namet; use Namet;
! with Osint; use Osint;
! with Output; use Output;
! with Prj.Com; use Prj.Com;
! with Prj.Util; use Prj.Util;
! with Snames; use Snames;
! with Stringt; use Stringt;
! with Types; use Types;
package body Prj.Nmsc is
--- 26,47 ----
-- --
------------------------------------------------------------------------------
! with Ada.Characters.Handling; use Ada.Characters.Handling;
! with Ada.Strings; use Ada.Strings;
! with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
! with Errout; use Errout;
! with GNAT.Case_Util; use GNAT.Case_Util;
! with GNAT.Directory_Operations; use GNAT.Directory_Operations;
! with GNAT.OS_Lib; use GNAT.OS_Lib;
! with Namet; use Namet;
! with Osint; use Osint;
! with Output; use Output;
! with Prj.Com; use Prj.Com;
! with Prj.Util; use Prj.Util;
! with Snames; use Snames;
! with Stringt; use Stringt;
! with Types; use Types;
package body Prj.Nmsc is
***************
*** 58,66 ****
-- Check that a name is a valid Ada unit name.
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
! -- Output an error message.
! -- If Error_Report is null, simply call Errout.Error_Msg.
! -- Otherwise, disregard Flag_Location and use Error_Report.
function Get_Name_String (S : String_Id) return String;
-- Get the string from a String_Id
--- 58,66 ----
-- Check that a name is a valid Ada unit name.
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
! -- Output an error message. If Error_Report is null, simply call
! -- Errout.Error_Msg. Otherwise, disregard Flag_Location and use
! -- Error_Report.
function Get_Name_String (S : String_Id) return String;
-- Get the string from a String_Id
***************
*** 71,80 ****
Unit_Name : out Name_Id;
Unit_Kind : out Spec_Or_Body;
Needs_Pragma : out Boolean);
! -- Find out, from a file name, the unit name, the unit kind
! -- and if a specific SFN pragma is needed.
! -- If the file name corresponds to no unit, then Unit_Name
! -- will be No_Name.
function Is_Illegal_Append (This : String) return Boolean;
-- Returns True if the string This cannot be used as
--- 71,79 ----
Unit_Name : out Name_Id;
Unit_Kind : out Spec_Or_Body;
Needs_Pragma : out Boolean);
! -- Find out, from a file name, the unit name, the unit kind and if a
! -- specific SFN pragma is needed. If the file name corresponds to no
! -- unit, then Unit_Name will be No_Name.
function Is_Illegal_Append (This : String) return Boolean;
-- Returns True if the string This cannot be used as
***************
*** 96,116 ****
function Locate_Directory
(Name : Name_Id;
Parent : Name_Id)
! return Name_Id;
-- Locate a directory.
-- Returns No_Name if directory does not exist.
function Path_Name_Of
(File_Name : String_Id;
Directory : Name_Id)
! return String;
-- Returns the path name of a (non project) file.
-- Returns an empty string if file cannot be found.
function Path_Name_Of
(File_Name : String_Id;
Directory : String_Id)
! return String;
-- Same as above except that Directory is a String_Id instead
-- of a Name_Id.
--- 95,115 ----
function Locate_Directory
(Name : Name_Id;
Parent : Name_Id)
! return Name_Id;
-- Locate a directory.
-- Returns No_Name if directory does not exist.
function Path_Name_Of
(File_Name : String_Id;
Directory : Name_Id)
! return String;
-- Returns the path name of a (non project) file.
-- Returns an empty string if file cannot be found.
function Path_Name_Of
(File_Name : String_Id;
Directory : String_Id)
! return String;
-- Same as above except that Directory is a String_Id instead
-- of a Name_Id.
***************
*** 170,176 ****
Element.Value.Location);
else
-
if Current_Verbosity = High then
Write_Str (" Body_Part (""");
Write_Str (Get_Name_String (Unit_Name));
--- 169,174 ----
***************
*** 348,355 ****
Name_Len := Path_Name'Length;
Name_Buffer (1 .. Name_Len) := Path_Name.all;
! -- We register the source.
! -- We report an error if the file does not
-- correspond to a source.
Record_Source
--- 346,352 ----
Name_Len := Path_Name'Length;
Name_Buffer (1 .. Name_Len) := Path_Name.all;
! -- Register the source. Report an error if the file does not
-- correspond to a source.
Record_Source
***************
*** 434,440 ****
-- Start of processing for Ada_Check
begin
-
Language_Independent_Check (Project, Report_Error);
Error_Report := Report_Error;
--- 431,436 ----
***************
*** 466,471 ****
--- 462,468 ----
end loop Look_For_Ada;
if not Ada_Found then
+
-- Mark the project file as having no sources for Ada
Data.Sources_Present := False;
***************
*** 538,543 ****
--- 535,541 ----
-- We are now checking if variables Dot_Replacement, Casing,
-- Specification_Append, Body_Append and/or Separate_Append
-- exist.
+
-- For each variable, if it does not exist, we do nothing,
-- because we already have the default.
***************
*** 909,922 ****
end if;
end loop;
! -- We cannot end with an underscore or a dot
OK := OK and then not Need_Letter and then not Last_Underscore;
if OK then
Unit := Name;
else
! -- We signal a problem with No_Name
Unit := No_Name;
end if;
--- 907,920 ----
end if;
end loop;
! -- Cannot end with an underscore or a dot
OK := OK and then not Need_Letter and then not Last_Underscore;
if OK then
Unit := Name;
else
! -- Signal a problem with No_Name
Unit := No_Name;
end if;
***************
*** 1048,1134 ****
---------------
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
begin
if Error_Report = null then
Errout.Error_Msg (Msg, Flag_Location);
!
! else
! declare
! Error_Buffer : String (1 .. 5_000);
! Error_Last : Natural := 0;
! Msg_Name : Natural := 0;
! First : Positive := Msg'First;
! procedure Add (C : Character);
! -- Add a character to the buffer
! procedure Add (S : String);
! -- Add a string to the buffer
! procedure Add (Id : Name_Id);
! -- Add a name to the buffer
! ---------
! -- Add --
! ---------
! procedure Add (C : Character) is
! begin
! Error_Last := Error_Last + 1;
! Error_Buffer (Error_Last) := C;
! end Add;
!
! procedure Add (S : String) is
! begin
! Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
! Error_Last := Error_Last + S'Length;
! end Add;
! procedure Add (Id : Name_Id) is
! begin
! Get_Name_String (Id);
! Add (Name_Buffer (1 .. Name_Len));
! end Add;
! begin
! if Msg (First) = '\' then
! -- Continuation character, ignore.
! First := First + 1;
! elsif Msg (First) = '?' then
! -- Warning character. It is always the first one,
! -- in this package.
! First := First + 1;
! Add ("Warning: ");
! end if;
! for Index in First .. Msg'Last loop
! if Msg (Index) = '{' or else Msg (Index) = '%' then
! -- Include a name between double quotes.
! Msg_Name := Msg_Name + 1;
! Add ('"');
! case Msg_Name is
! when 1 => Add (Error_Msg_Name_1);
! when 2 => Add (Error_Msg_Name_2);
! when 3 => Add (Error_Msg_Name_3);
! when others => null;
! end case;
! Add ('"');
! else
! Add (Msg (Index));
! end if;
! end loop;
! Error_Report (Error_Buffer (1 .. Error_Last));
! end;
! end if;
end Error_Msg;
---------------------
--- 1046,1138 ----
---------------
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
+
+ Error_Buffer : String (1 .. 5_000);
+ Error_Last : Natural := 0;
+ Msg_Name : Natural := 0;
+ First : Positive := Msg'First;
+
+ procedure Add (C : Character);
+ -- Add a character to the buffer
+
+ procedure Add (S : String);
+ -- Add a string to the buffer
+
+ procedure Add (Id : Name_Id);
+ -- Add a name to the buffer
+
+ ---------
+ -- Add --
+ ---------
+
+ procedure Add (C : Character) is
+ begin
+ Error_Last := Error_Last + 1;
+ Error_Buffer (Error_Last) := C;
+ end Add;
+
+ procedure Add (S : String) is
+ begin
+ Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
+ Error_Last := Error_Last + S'Length;
+ end Add;
+
+ procedure Add (Id : Name_Id) is
+ begin
+ Get_Name_String (Id);
+ Add (Name_Buffer (1 .. Name_Len));
+ end Add;
+
+ -- Start of processing for Error_Msg
+
begin
if Error_Report = null then
Errout.Error_Msg (Msg, Flag_Location);
! return;
! end if;
! if Msg (First) = '\' then
! -- Continuation character, ignore.
! First := First + 1;
! elsif Msg (First) = '?' then
! -- Warning character. It is always the first one,
! -- in this package.
! First := First + 1;
! Add ("Warning: ");
! end if;
! for Index in First .. Msg'Last loop
! if Msg (Index) = '{' or else Msg (Index) = '%' then
! -- Include a name between double quotes.
! Msg_Name := Msg_Name + 1;
! Add ('"');
! case Msg_Name is
! when 1 => Add (Error_Msg_Name_1);
! when 2 => Add (Error_Msg_Name_2);
! when 3 => Add (Error_Msg_Name_3);
! when others => null;
! end case;
! Add ('"');
! else
! Add (Msg (Index));
! end if;
! end loop;
! Error_Report (Error_Buffer (1 .. Error_Last));
end Error_Msg;
---------------------
***************
*** 2090,2096 ****
function Locate_Directory
(Name : Name_Id;
Parent : Name_Id)
! return Name_Id
is
The_Name : constant String := Get_Name_String (Name);
The_Parent : constant String :=
--- 2094,2100 ----
function Locate_Directory
(Name : Name_Id;
Parent : Name_Id)
! return Name_Id
is
The_Name : constant String := Get_Name_String (Name);
The_Parent : constant String :=
***************
*** 2173,2179 ****
function Path_Name_Of
(File_Name : String_Id;
Directory : Name_Id)
! return String
is
Result : String_Access;
The_Directory : constant String := Get_Name_String (Directory);
--- 2177,2183 ----
function Path_Name_Of
(File_Name : String_Id;
Directory : Name_Id)
! return String
is
Result : String_Access;
The_Directory : constant String := Get_Name_String (Directory);
*** prj-nmsc.adb 2001/10/05 16:25:33 1.27
--- prj-nmsc.adb 2001/10/06 13:38:57 1.28
***************
*** 584,590 ****
begin
pragma Assert (Casing_String.Kind = Single,
! "Dot_Replacement is not a single string");
if not Casing_String.Default then
declare
--- 584,590 ----
begin
pragma Assert (Casing_String.Kind = Single,
! "Casing is not a single string");
if not Casing_String.Default then
declare
***************
*** 681,687 ****
(Variable_Name => Name_Separate_Suffix,
In_Variables => Naming.Decl.Attributes);
begin
! if Ada_Sep_Suffix = Nil_Variable_Value then
Data.Naming.Separate_Suffix :=
Data.Naming.Current_Impl_Suffix;
--- 681,687 ----
(Variable_Name => Name_Separate_Suffix,
In_Variables => Naming.Decl.Attributes);
begin
! if Ada_Sep_Suffix.Default then
Data.Naming.Separate_Suffix :=
Data.Naming.Current_Impl_Suffix;