MatCat.OpenSource/8sa1-gcc
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
3b56934fb9
8sa1-gcc/gcc/ada/prj-nmsc.adb
Geert Bosch 79503fdd33 * make.adb: 
(Switches_Of): New function
	(Test_If_Relative_Path): New procedure
	(Add_Switches): Use new function Switches_Of
	(Collect_Arguments_And_Compile): Use new function Switches_Of.
	When using a project file, test if there are any relative
	search path. Fail if there are any.
	(Gnatmake): Only add switches for the primary directory when not using
	a project file. When using a project file, change directory to the
	object directory of the main project file. When using a project file,
	test if there are any relative search path. Fail if there are any.
	When using a project file, fail if specified executable is relative
	path with directory information, and prepend executable, if not
	specified as an absolute path, with the exec directory.  Make sure
	that only one -o switch is transmitted to the linker.

	* prj-attr.adb (Initialization_Data): Add project attribute Exec_Dir

	* prj-nmsc.adb:
	(Ada_Check): Get Spec_Suffix_Loc and Impl_Suffix_Loc,
	when using a non standard naming scheme.
	(Check_Ada_Naming_Scheme): Make sure that error messages
	do not raise exceptions.
	(Is_Illegal_Append): Return True if there is no dot in the suffix.
	(Language_Independent_Check): Check the exec directory.

	* prj.adb (Project_Empty): Add new component Exec_Directory

	* prj.ads:
	(Default_Ada_Spec_Suffix, Default_Ada_Impl_Suffix): Add defaults.
	(Project_Data): Add component Exec_Directory

	* snames.adb: Updated to match snames.ads revision 1.215

	* snames.ads: Added Exec_Dir

	* make.adb: Minor reformatting

	* prj-nmsc.adb: Minor reformatting

	* snames.adb: Updated to match snames.ads

	* snames.ads: Alphebetize entries for project file

	* trans.c (process_freeze_entity): Do nothing if the entity is a
	subprogram that was already elaborated.

	* decl.c (gnat_to_gnu_entity, object): Do not back-annotate Alignment
	and Esize if object is referenced via pointer.

From-SVN: r48127
2001-12-17 22:19:32 +01:00

2426 lines
78 KiB
Ada
Raw Blame History

------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- P R J . N M S C --
-- --
-- B o d y --
-- --
-- $Revision$
-- --
-- Copyright (C) 2000-2001 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
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 MLib.Tgt;
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
Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
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. 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
procedure Get_Unit
(File_Name : Name_Id;
Naming : Naming_Data;
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
-- a Specification_Append, a Body_Append or a Separate_Append.
procedure Record_Source
(File_Name : Name_Id;
Path_Name : Name_Id;
Project : Project_Id;
Data : in out Project_Data;
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.
procedure Show_Source_Dirs (Project : Project_Id);
-- List all the source directories of a project.
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.
---------------
-- 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.
procedure Get_Path_Name_And_Record_Source
(File_Name : String;
Location : Source_Ptr;
Current_Source : in out String_List_Id);
-- Find the path name of a source in the source directories and
-- record the source, if found.
procedure Get_Sources_From_File
(Path : String;
Location : Source_Ptr);
-- Get the sources of a project from a text file
----------------------
-- Check_Unit_Names --
----------------------
procedure Check_Unit_Names (List : Array_Element_Id) is
Current : Array_Element_Id := List;
Element : Array_Element;
Unit_Name : Name_Id;
begin
-- Loop through elements of the string list
while Current /= No_Array_Element loop
Element := Array_Elements.Table (Current);
-- 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;
Error_Msg
("{ is not a valid unit name.",
Element.Value.Location);
else
if Current_Verbosity = High then
Write_Str (" Body_Part (""");
Write_Str (Get_Name_String (Unit_Name));
Write_Line (""")");
end if;
Element.Index := Unit_Name;
Array_Elements.Table (Current) := Element;
end if;
Current := Element.Next;
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
if Path_Access /= null then
File_Name := Name_Find;
Name_Len := Path_Access'Length;
Name_Buffer (1 .. Name_Len) := Path_Access.all;
Path_Name := Name_Find;
-- We attempt to register it as a source.
-- However, there is no error if the file
-- does not contain a valid source.
-- But there is an error if we have a
-- duplicate unit name.
Record_Source
(File_Name => File_Name,
Path_Name => Path_Name,
Project => Project,
Data => Data,
Location => No_Location,
Current_Source => Current_Source);
else
if Current_Verbosity = High then
Write_Line
(" Not a regular file.");
end if;
end if;
end;
end loop;
Close (Dir);
end;
end if;
exception
when Directory_Error =>
null;
end;
Source_Dir := Element.Next;
end loop;
if Current_Verbosity = High then
Write_Line ("end Looking for sources.");
end if;
-- If we have looked for sources and found none, then
-- it is an error. If a project is not supposed to contain
-- any source, then we never call Find_Sources.
if Current_Source = Nil_String then
Error_Msg ("there are no sources in this project",
Data.Location);
end if;
end Find_Sources;
-------------------------------------
-- Get_Path_Name_And_Record_Source --
-------------------------------------
procedure Get_Path_Name_And_Record_Source
(File_Name : String;
Location : Source_Ptr;
Current_Source : in out String_List_Id)
is
Source_Dir : String_List_Id := Data.Source_Dirs;
Element : String_Element;
Path_Name : GNAT.OS_Lib.String_Access;
Found : Boolean := False;
File : Name_Id;
begin
if Current_Verbosity = High then
Write_Str (" Checking """);
Write_Str (File_Name);
Write_Line (""".");
end if;
-- We look in all source directories for this file name
while Source_Dir /= Nil_String loop
Element := String_Elements.Table (Source_Dir);
if Current_Verbosity = High then
Write_Str (" """);
Write_Str (Get_Name_String (Element.Value));
Write_Str (""": ");
end if;
Path_Name :=
Locate_Regular_File
(File_Name,
Get_Name_String (Element.Value));
if Path_Name /= null then
if Current_Verbosity = High then
Write_Line ("OK");
end if;
Name_Len := File_Name'Length;
Name_Buffer (1 .. Name_Len) := File_Name;
File := Name_Find;
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
(File_Name => File,
Path_Name => Name_Find,
Project => Project,
Data => Data,
Location => Location,
Current_Source => Current_Source);
Found := True;
exit;
else
if Current_Verbosity = High then
Write_Line ("No");
end if;
Source_Dir := Element.Next;
end if;
end loop;
end Get_Path_Name_And_Record_Source;
---------------------------
-- Get_Sources_From_File --
---------------------------
procedure Get_Sources_From_File
(Path : String;
Location : Source_Ptr)
is
File : Prj.Util.Text_File;
Line : String (1 .. 250);
Last : Natural;
Current_Source : String_List_Id := Nil_String;
Nmb_Errors : constant Nat := Errors_Detected;
begin
if Current_Verbosity = High then
Write_Str ("Opening """);
Write_Str (Path);
Write_Line (""".");
end if;
-- We open the file
Prj.Util.Open (File, Path);
if not Prj.Util.Is_Valid (File) then
Error_Msg ("file does not exist", Location);
else
while not Prj.Util.End_Of_File (File) loop
Prj.Util.Get_Line (File, Line, Last);
-- If the line is not empty and does not start with "--",
-- then it must contains a file name.
if Last /= 0
and then (Last = 1 or else Line (1 .. 2) /= "--")
then
Get_Path_Name_And_Record_Source
(File_Name => Line (1 .. Last),
Location => Location,
Current_Source => Current_Source);
exit when Nmb_Errors /= Errors_Detected;
end if;
end loop;
Prj.Util.Close (File);
end if;
-- We should have found at least one source.
-- If not, report an error.
if Current_Source = Nil_String then
Error_Msg ("this project has no source", Location);
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,
"Casing 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 Variable_Value :=
Prj.Util.Value_Of
(Index => Name_Ada,
In_Array => Data.Naming.Specification_Suffix);
begin
if Ada_Spec_Suffix.Kind = Single
and then String_Length (Ada_Spec_Suffix.Value) /= 0
then
String_To_Name_Buffer (Ada_Spec_Suffix.Value);
Data.Naming.Current_Spec_Suffix := Name_Find;
Data.Naming.Spec_Suffix_Loc := Ada_Spec_Suffix.Location;
else
Data.Naming.Current_Spec_Suffix := Default_Ada_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 Variable_Value :=
Prj.Util.Value_Of
(Index => Name_Ada,
In_Array => Data.Naming.Implementation_Suffix);
begin
if Ada_Impl_Suffix.Kind = Single
and then String_Length (Ada_Impl_Suffix.Value) /= 0
then
String_To_Name_Buffer (Ada_Impl_Suffix.Value);
Data.Naming.Current_Impl_Suffix := Name_Find;
Data.Naming.Impl_Suffix_Loc := Ada_Impl_Suffix.Location;
else
Data.Naming.Current_Impl_Suffix := Default_Ada_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.Default 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 := Default_Ada_Spec_Suffix;
Data.Naming.Current_Impl_Suffix := Default_Ada_Impl_Suffix;
Data.Naming.Separate_Suffix := Default_Ada_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;
-- 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;
end Check_Ada_Name;
-----------------------------
-- Check_Ada_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;
-- Suffixes cannot
-- - be empty
-- - start with an alphanumeric
-- - start with an '_' followed by an alphanumeric
if Is_Illegal_Append (Specification_Suffix) then
Error_Msg_Name_1 := Naming.Current_Spec_Suffix;
Error_Msg
("{ is illegal for Specification_Suffix",
Naming.Spec_Suffix_Loc);
end if;
if Is_Illegal_Append (Implementation_Suffix) then
Error_Msg_Name_1 := Naming.Current_Impl_Suffix;
Error_Msg
("% 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_Name_1 := Naming.Separate_Suffix;
Error_Msg
("{ 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 --
---------------
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;
---------------------
-- Get_Name_String --
---------------------
function Get_Name_String (S : String_Id) return String is
begin
if S = No_String then
return "";
else
String_To_Name_Buffer (S);
return Name_Buffer (1 .. Name_Len);
end if;
end Get_Name_String;
--------------
-- Get_Unit --
--------------
procedure Get_Unit
(File_Name : Name_Id;
Naming : Naming_Data;
Unit_Name : out Name_Id;
Unit_Kind : out Spec_Or_Body;
Needs_Pragma : out Boolean)
is
Canonical_Case_Name : Name_Id;
begin
Needs_Pragma := False;
Get_Name_String (File_Name);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Canonical_Case_Name := Name_Find;
if Naming.Bodies /= No_Array_Element then
-- There are some specified file names for some bodies
-- of this project. Find out if File_Name is one of these bodies.
declare
Current : Array_Element_Id := Naming.Bodies;
Element : Array_Element;
begin
while Current /= No_Array_Element loop
Element := Array_Elements.Table (Current);
if Element.Index /= No_Name then
String_To_Name_Buffer (Element.Value.Value);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
if Canonical_Case_Name = Name_Find then
-- File_Name corresponds to one body.
-- So, we know it is a body, and we know the unit name.
Unit_Kind := Body_Part;
Unit_Name := Element.Index;
Needs_Pragma := True;
return;
end if;
end if;
Current := Element.Next;
end loop;
end;
end if;
if Naming.Specifications /= No_Array_Element then
-- There are some specified file names for some bodiesspecifications
-- of this project. Find out if File_Name is one of these
-- specifications.
declare
Current : Array_Element_Id := Naming.Specifications;
Element : Array_Element;
begin
while Current /= No_Array_Element loop
Element := Array_Elements.Table (Current);
if Element.Index /= No_Name then
String_To_Name_Buffer (Element.Value.Value);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
if Canonical_Case_Name = Name_Find then
-- File_Name corresponds to one specification.
-- So, we know it is a spec, and we know the unit name.
Unit_Kind := Specification;
Unit_Name := Element.Index;
Needs_Pragma := True;
return;
end if;
end if;
Current := Element.Next;
end loop;
end;
end if;
declare
File : String := Get_Name_String (Canonical_Case_Name);
First : Positive := File'First;
Last : Natural := File'Last;
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) =
Name_Buffer (1 .. Name_Len)
then
-- We have a spec
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 Index (This, ".") = 0
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;
-- 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;
-- Check the exec directory
declare
Exec_Dir : Variable_Value :=
Util.Value_Of (Name_Exec_Dir, Data.Decl.Attributes);
begin
pragma Assert (Exec_Dir.Kind = Single,
"Exec_Dir is not a single string");
-- We set the object directory to its default
Data.Exec_Directory := Data.Object_Directory;
if not String_Equal (Exec_Dir.Value, Empty_String) then
String_To_Name_Buffer (Exec_Dir.Value);
if Name_Len = 0 then
Error_Msg ("Exec_Dir cannot be empty",
Exec_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.Exec_Directory :=
Locate_Directory (Dir_Id, Data.Directory);
if Data.Exec_Directory = No_Name then
Error_Msg_Name_1 := Dir_Id;
Error_Msg
("the exec directory { cannot be found",
Data.Location);
end if;
end;
end if;
end if;
end;
if Current_Verbosity = High then
if Data.Exec_Directory = No_Name then
Write_Line ("No exec directory");
else
Write_Str ("Exec directory: """);
Write_Str (Get_Name_String (Data.Exec_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 not MLib.Tgt.Libraries_Are_Supported then
Error_Msg ("?libraries are not supported on this platform",
Lib_Name.Location);
Data.Library := False;
else
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;
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 --
----------------------
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 :=
Get_Name_String (Parent) & Dir_Sep;
The_Parent_Last : Positive := The_Parent'Last;
begin
if The_Parent'Length > 1
and then (The_Parent (The_Parent_Last - 1) = Dir_Sep
or else The_Parent (The_Parent_Last - 1) = '/')
then
The_Parent_Last := The_Parent_Last - 1;
end if;
if Current_Verbosity = High then
Write_Str ("Locate_Directory (""");
Write_Str (The_Name);
Write_Str (""", """);
Write_Str (The_Parent);
Write_Line (""")");
end if;
if Is_Absolute_Path (The_Name) then
if Is_Directory (The_Name) then
return Name;
end if;
else
declare
Full_Path : constant String :=
The_Parent (The_Parent'First .. The_Parent_Last) &
The_Name;
begin
if Is_Directory (Full_Path) then
Name_Len := Full_Path'Length;
Name_Buffer (1 .. Name_Len) := Full_Path;
return Name_Find;
end if;
end;
end if;
return No_Name;
end Locate_Directory;
------------------
-- Path_Name_Of --
------------------
function Path_Name_Of
(File_Name : String_Id;
Directory : String_Id)
return String
is
Result : String_Access;
begin
String_To_Name_Buffer (File_Name);
declare
The_File_Name : constant String := Name_Buffer (1 .. Name_Len);
begin
String_To_Name_Buffer (Directory);
Result := Locate_Regular_File
(File_Name => The_File_Name,
Path => Name_Buffer (1 .. Name_Len));
end;
if Result = null then
return "";
else
Canonical_Case_File_Name (Result.all);
return Result.all;
end if;
end Path_Name_Of;
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);
begin
String_To_Name_Buffer (File_Name);
Result := Locate_Regular_File
(File_Name => Name_Buffer (1 .. Name_Len),
Path => The_Directory);
if Result = null then
return "";
else
Canonical_Case_File_Name (Result.all);
return Result.all;
end if;
end Path_Name_Of;
-------------------
-- Record_Source --
-------------------
procedure Record_Source
(File_Name : Name_Id;
Path_Name : Name_Id;
Project : Project_Id;
Data : in out Project_Data;
Location : Source_Ptr;
Current_Source : in out String_List_Id)
is
Unit_Name : Name_Id;
Unit_Kind : Spec_Or_Body;
Needs_Pragma : Boolean;
The_Location : Source_Ptr := Location;
begin
-- Find out the unit name, the unit kind and if it needs
-- a specific SFN pragma.
Get_Unit
(File_Name => File_Name,
Naming => Data.Naming,
Unit_Name => Unit_Name,
Unit_Kind => Unit_Kind,
Needs_Pragma => Needs_Pragma);
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
-- Put the file name in the list of sources of the project
String_Elements.Increment_Last;
Get_Name_String (File_Name);
Start_String;
Store_String_Chars (Name_Buffer (1 .. Name_Len));
String_Elements.Table (String_Elements.Last) :=
(Value => End_String,
Location => No_Location,
Next => Nil_String);
if Current_Source = Nil_String then
Data.Sources := String_Elements.Last;
else
String_Elements.Table (Current_Source).Next :=
String_Elements.Last;
end if;
Current_Source := String_Elements.Last;
-- Put the unit in unit list
declare
The_Unit : Unit_Id := Units_Htable.Get (Unit_Name);
The_Unit_Data : Unit_Data;
begin
if Current_Verbosity = High then
Write_Str ("Putting ");
Write_Str (Get_Name_String (Unit_Name));
Write_Line (" in the unit list.");
end if;
-- The unit is already in the list, but may be it is
-- only the other unit kind (spec or body), or what is
-- in the unit list is a unit of a project we are extending.
if The_Unit /= Prj.Com.No_Unit then
The_Unit_Data := Units.Table (The_Unit);
if The_Unit_Data.File_Names (Unit_Kind).Name = No_Name
or else (Data.Modifies /= No_Project
and then
The_Unit_Data.File_Names (Unit_Kind).Project =
Data.Modifies)
then
The_Unit_Data.File_Names (Unit_Kind) :=
(Name => File_Name,
Path => Path_Name,
Project => Project,
Needs_Pragma => Needs_Pragma);
Units.Table (The_Unit) := The_Unit_Data;
else
-- It is an error to have two units with the same name
-- and the same kind (spec or body).
if The_Location = No_Location then
The_Location := Projects.Table (Project).Location;
end if;
Error_Msg_Name_1 := Unit_Name;
Error_Msg ("duplicate source {", The_Location);
Error_Msg_Name_1 :=
Projects.Table
(The_Unit_Data.File_Names (Unit_Kind).Project).Name;
Error_Msg_Name_2 :=
The_Unit_Data.File_Names (Unit_Kind).Path;
Error_Msg ("\ project file {, {", The_Location);
Error_Msg_Name_1 := Projects.Table (Project).Name;
Error_Msg_Name_2 := Path_Name;
Error_Msg ("\ project file {, {", The_Location);
end if;
-- It is a new unit, create a new record
else
Units.Increment_Last;
The_Unit := Units.Last;
Units_Htable.Set (Unit_Name, The_Unit);
The_Unit_Data.Name := Unit_Name;
The_Unit_Data.File_Names (Unit_Kind) :=
(Name => File_Name,
Path => Path_Name,
Project => Project,
Needs_Pragma => Needs_Pragma);
Units.Table (The_Unit) := The_Unit_Data;
end if;
end;
end if;
end Record_Source;
----------------------
-- Show_Source_Dirs --
----------------------
procedure Show_Source_Dirs (Project : Project_Id) is
Current : String_List_Id := Projects.Table (Project).Source_Dirs;
Element : String_Element;
begin
Write_Line ("Source_Dirs:");
while Current /= Nil_String loop
Element := String_Elements.Table (Current);
Write_Str (" ");
Write_Line (Get_Name_String (Element.Value));
Current := Element.Next;
end loop;
Write_Line ("end Source_Dirs.");
end Show_Source_Dirs;
end Prj.Nmsc;
Reference in New Issue View Git Blame Copy Permalink