------------------------------------------------------------------------------
-- --
-- GPR PROJECT MANAGER --
-- --
-- Copyright (C) 2001-2023, AdaCore --
-- --
-- This 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 3, or (at your option) any later ver- --
-- sion. This software is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY 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, --
-- see . --
-- --
------------------------------------------------------------------------------
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Containers.Indefinite_Vectors;
with Ada.Containers.Vectors;
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Command_Line; use GNAT.Command_Line;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GPR;
with GPR.Conf;
with GPR.Env;
with GPR.Names; use GPR.Names;
with GPR.Opt;
with GPR.Osint; use GPR.Osint;
with GPR.Snames; use GPR.Snames;
with GPR.Tree; use GPR.Tree;
with GPR.Util; use GPR.Util;
with Gpr_Build_Util; use Gpr_Build_Util;
with System.Regexp; use System.Regexp;
procedure GPRName.Main is
Usage_Output : Boolean := False;
-- Set to True when usage is output, to avoid multiple output
Usage_Needed : Boolean := False;
-- Set to True by -h switch
Version_Output : Boolean := False;
-- Set to True when version is output, to avoid multiple output
Very_Verbose : Boolean := False;
-- Set to True with -v -v
File_Path : String_Access := null;
-- Path name of the file specified -P switch
File_Set : Boolean := False;
-- Set to True by -P switch.
-- Used to detect multiple -P switches.
Project_File_Name_Expected : Boolean := False;
-- True when switch "-P" has just been scanned
Directory_Expected : Boolean := False;
-- True when switch "-d" has just been scanned
Dir_File_Name_Expected : Boolean := False;
-- True when switch "-D" has just been scanned
Foreign_Pattern_Expected : Boolean := False;
-- True when switch "-f" has just been scanned
Foreign_Language : Name_Id := No_Name;
Excluded_Pattern_Expected : Boolean := False;
-- True when switch "-x" has just been scanned
type Foreign_Pattern (Ptrn_Len : Natural) is record
Language : Name_Id := No_Name;
Pattern : String (1 .. Ptrn_Len);
end record;
package Foreign_Patterns is new Ada.Containers.Indefinite_Vectors
(Positive, Foreign_Pattern);
-- Table to accumulate the patterns for non Ada sources
type Argument_Data is record
Directories : String_Vectors.Vector;
Name_Patterns : String_Vectors.Vector;
Excluded_Patterns : String_Vectors.Vector;
Foreign_Sources_Patterns : Foreign_Patterns.Vector;
end record;
package Argument_Data_Vectors is new Ada.Containers.Vectors
(Positive, Argument_Data);
Arguments : Argument_Data_Vectors.Vector;
-- Table to accumulate directories and patterns
Preprocessor_Switches : String_Vectors.Vector;
-- Table to store the preprocessor switches to be used in the call
-- to the compiler.
procedure Add_Source_Directory (S : String);
-- Add S in the Source_Directories table
procedure Check_Regular_Expression (S : String);
-- Compile string S into a Regexp, fail if any error
procedure Get_Directories (From_File : String);
-- Read a source directory text file
procedure Initialize;
-- Do the necessary package intialization and process the command line
-- arguments.
procedure Output_Version;
-- Print name and version
procedure Scan_Arg (Arg : String);
-- Process on of the command line argument
procedure Usage;
-- Print usage
--------------------------
-- Add_Source_Directory --
--------------------------
procedure Add_Source_Directory (S : String)
is
procedure Update (List : in out Argument_Data);
procedure Update (List : in out Argument_Data)
is
begin
List.Directories.Append (S);
end Update;
begin
Argument_Data_Vectors.Update_Element
(Arguments, Arguments.Last_Index, Update'Access);
end Add_Source_Directory;
-----------------------------
-- Check_Regular_Expression--
-----------------------------
procedure Check_Regular_Expression (S : String) is
Dummy : Regexp;
pragma Warnings (Off, Dummy);
begin
Dummy := Compile (S, Glob => True);
exception
when Error_In_Regexp =>
Fail ("invalid regular expression """ & S & """");
end Check_Regular_Expression;
---------------------
-- Get_Directories --
---------------------
procedure Get_Directories (From_File : String) is
File : Ada.Text_IO.File_Type;
Line : String (1 .. 2_000);
Last : Natural;
begin
Open (File, In_File, From_File);
while not End_Of_File (File) loop
Get_Line (File, Line, Last);
if Last /= 0 then
Add_Source_Directory (Line (1 .. Last));
end if;
end loop;
Close (File);
exception
when Name_Error =>
Fail ("cannot open source directory file """ & From_File & '"');
end Get_Directories;
----------------
-- Initialize --
----------------
procedure Initialize is
procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
User_Project_Node : Project_Node_Id;
-- Used to call Parse_Project_And_Apply_Config
begin
-- Do some necessary package initializations
GPR.Snames.Initialize;
Set_Program_Name ("gprname");
GPR.Tree.Initialize (Root_Environment, Gprname_Flags);
GPR.Tree.Initialize (Project_Node_Tree);
GPR.Initialize (Project_Tree);
-- Initialize tables
Arguments.Clear;
Arguments.Append (Argument_Data'(others => <>));
Preprocessor_Switches.Clear;
-- First check for --version or --help
Check_Version_And_Help ("GPRNAME", "2001");
-- Now scan the other switches
Project_File_Name_Expected := False;
Directory_Expected := False;
Dir_File_Name_Expected := False;
Foreign_Pattern_Expected := False;
Excluded_Pattern_Expected := False;
for Next_Arg in 1 .. Argument_Count loop
Scan_Arg (Argument (Next_Arg));
end loop;
if Project_File_Name_Expected or else not File_Set then
Fail ("project file name missing");
elsif File_Path = null then
Try_Help;
Fail_Program (null, "no project file specified");
elsif Directory_Expected then
Fail ("directory name missing");
elsif Dir_File_Name_Expected then
Fail ("directory list file name missing");
elsif Foreign_Pattern_Expected then
Fail ("foreign pattern missing");
elsif Excluded_Pattern_Expected then
Fail ("excluded pattern missing");
end if;
GPR.Env.Initialize_Default_Project_Path
(Root_Environment.Project_Path, Target_Name => "-");
if Load_Standard_Base then
-- We need to parse the knowledge base so that we are able to
-- normalize the target names. Unfortunately, if we have to spawn
-- gprconfig, it will also have to parse that knowledge base on
-- its own.
Knowledge.Parse_Knowledge_Base (Project_Tree);
end if;
if Target_Name = null then
Target_Name := new String'("");
end if;
if Config_Project_File_Name = null then
Config_Project_File_Name := new String'("");
end if;
-- Check if the project file already exists
declare
Path_Name : constant String :=
Normalize_Pathname
(Ensure_Extension
(File_Path.all, Project_File_Extension),
Case_Sensitive => False);
begin
Free (File_Path);
File_Path := new String'(Path_Name);
end;
if Is_Regular_File (File_Path.all) then
if Opt.Verbose_Mode then
Put_Line
("Parsing already existing project file """ &
File_Path.all & "");
end if;
else
-- The project file does not exist; create an empty one
declare
File : File_Type;
File_Name_Start : Positive := File_Path'First;
File_Name_Last : constant Positive :=
File_Path'Last - Project_File_Extension'Length;
begin
for J in reverse File_Path'Range loop
if File_Path (J) = Directory_Separator then
File_Name_Start := J + 1;
exit;
end if;
end loop;
Create (File, Out_File, File_Path.all);
Put (File, "project ");
Put (File, File_Path (File_Name_Start .. File_Name_Last));
Put_Line (File, " is");
Put (File, "end ");
Put (File, File_Path (File_Name_Start .. File_Name_Last));
Put_Line (File, ";");
Close (File);
exception
when others =>
Fail ("could not create project file " & File_Path.all);
end;
end if;
begin
GPR.Opt.Warning_Mode := GPR.Opt.Suppress;
GPR.Conf.Parse_Project_And_Apply_Config
(Main_Project => Main_Project,
User_Project_Node => User_Project_Node,
Config_File_Name => Config_Project_File_Name.all,
Autoconf_Specified => Autoconf_Specified,
Project_File_Name => File_Path.all,
Project_Tree => Project_Tree,
Env => Root_Environment,
Project_Node_Tree => Project_Node_Tree,
Packages_To_Check => Packages_To_Check,
Allow_Automatic_Generation => Autoconfiguration,
Automatically_Generated => Delete_Autoconf_File,
Config_File_Path => Configuration_Project_Path,
Target_Name => Target_Name.all,
Normalized_Hostname => Knowledge.Normalized_Hostname);
exception
when E : GPR.Conf.Invalid_Config =>
Fail_Program (Project_Tree, Exception_Message (E));
end;
if Main_Project = No_Project then
-- Don't flush messages in case of parsing error. This has already
-- been taken care when parsing the tree. Otherwise, it results in
-- the same message being displayed twice.
Fail_Program
(Project_Tree,
"""" & File_Path.all & """ processing failed",
Flush_Messages => Present (User_Project_Node));
else
declare
Ada_Lang : constant Language_Ptr :=
Get_Language_From_Name (Main_Project, "ada");
begin
if Ada_Lang /= No_Language_Index then
Gcc_Path := Get_Compiler_Driver_Path (Main_Project, Ada_Lang);
end if;
end;
end if;
end Initialize;
--------------------
-- Output_Version --
--------------------
procedure Output_Version is
begin
if not Version_Output then
Version_Output := True;
New_Line;
Display_Version ("GPRNAME", "2001");
end if;
end Output_Version;
--------------
-- Scan_Arg --
--------------
procedure Scan_Arg (Arg : String)
is
pragma Assert (Arg'First = 1);
procedure Add_Foreign_Source (Argument : in out Argument_Data);
------------------------
-- Add_Foreign_Source --
------------------------
procedure Add_Foreign_Source (Argument : in out Argument_Data)
is
begin
Argument.Foreign_Sources_Patterns.Append
(Foreign_Pattern'
(Ptrn_Len => Arg'Length,
Language => Foreign_Language,
Pattern => Arg));
end Add_Foreign_Source;
begin
if Arg'Length > 0 then
-- -P xxx
if Project_File_Name_Expected then
if Arg (1) = '-' then
Fail ("project file name missing");
else
File_Set := True;
File_Path := new String'(Arg);
Project_File_Name_Expected := False;
end if;
-- -d xxx
elsif Directory_Expected then
Add_Source_Directory (Arg);
Directory_Expected := False;
-- -D xxx
elsif Dir_File_Name_Expected then
Get_Directories (Arg);
Dir_File_Name_Expected := False;
-- -f xxx
elsif Foreign_Pattern_Expected then
Arguments.Update_Element
(Arguments.Last_Index, Add_Foreign_Source'Access);
Check_Regular_Expression (Arg);
Foreign_Pattern_Expected := False;
-- -x xxx
elsif Excluded_Pattern_Expected then
Arguments.Reference
(Arguments.Last).Element.Excluded_Patterns.Append (Arg);
Check_Regular_Expression (Arg);
Excluded_Pattern_Expected := False;
-- There must be at least one Ada pattern or one foreign pattern for
-- the previous section.
-- --and
elsif Arg = "--and" then
if Arguments.Last_Element.Name_Patterns.Is_Empty
and then Arguments.Last_Element.Foreign_Sources_Patterns.Is_Empty
then
Try_Help;
return;
end if;
-- If no directory were specified for the previous section, then
-- the directory is the project directory.
if Arguments.Last_Element.Directories.Is_Empty then
Arguments.Reference
(Arguments.Last).Element.Directories.Append (".");
end if;
-- Add and initialize another component to Arguments table
declare
New_Arguments : Argument_Data;
pragma Warnings (Off, New_Arguments);
-- Declaring this defaulted initialized object ensures that
-- the new allocated component of table Arguments is correctly
-- initialized.
begin
Arguments.Append (New_Arguments);
end;
-- --ignore-predefined-units
elsif Arg = "--ignore-predefined-units" then
Opt.Ignore_Predefined_Units := True;
-- --ignore-duplicate-files
elsif Arg = "--ignore-duplicate-files" then
Opt.Ignore_Duplicate_Files := True;
-- --no-backup
elsif Arg = "--no-backup" then
Opt.No_Backup := True;
-- --target=
elsif Arg'Length > Target_Project_Option'Length and then
Arg (1 .. Target_Project_Option'Length) = Target_Project_Option
then
if Target_Name = null then
Target_Name :=
new String'
(Arg (Target_Project_Option'Length + 1 .. Arg'Last));
elsif Target_Name.all /=
Arg (Target_Project_Option'Length + 1 .. Arg'Last)
then
Fail ("multiple targets");
end if;
-- --RTS=path
elsif Arg'Length >= 5 and then Arg (1 .. 5) = "--RTS" then
if Arg'Length <= 6 or else Arg (6) /= '='then
Osint.Fail ("missing path for --RTS");
else
-- Check that it is the first time we see this switch or, if
-- it is not the first time, the same path is specified.
if RTS_Specified = null then
RTS_Specified := new String'(Arg (7 .. Arg'Last));
GPR.Conf.Set_Runtime_For
(Snames.Name_Ada, Arg (7 .. Arg'Last));
elsif RTS_Specified.all /= Arg (7 .. Arg'Last) then
Osint.Fail ("--RTS cannot be specified multiple times");
end if;
end if;
-- -d
elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-d" then
if Arg'Length = 2 then
Directory_Expected := True;
else
Add_Source_Directory (Arg (3 .. Arg'Last));
end if;
-- -D
elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-D" then
if Arg'Length = 2 then
Dir_File_Name_Expected := True;
else
Get_Directories (Arg (3 .. Arg'Last));
end if;
-- -eL
elsif Arg = "-eL" then
Opt.Follow_Links_For_Files := True;
Opt.Follow_Links_For_Dirs := True;
-- -f
elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-f" then
if Arg'Length = 2 then
Foreign_Pattern_Expected := True;
Foreign_Language := Name_C;
elsif Arg (3) = ':' then
if Arg'Length = 3 then
Fail ("wrong switch: " & Arg);
else
Name_Len := Arg'Length - 3;
Name_Buffer (1 .. Name_Len) :=
To_Lower (Arg (4 .. Arg'Last));
Foreign_Language := Name_Find;
Foreign_Pattern_Expected := True;
end if;
else
Arguments.Reference
(Arguments.Last).Element.Foreign_Sources_Patterns.Append
(Foreign_Pattern'
(Ptrn_Len => Arg'Length - 2,
Language => Name_C,
Pattern => Arg (3 .. Arg'Last)));
Check_Regular_Expression (Arg (3 .. Arg'Last));
end if;
-- -gnatep or -gnateD
elsif Arg'Length > 7
and then Arg (1 .. 7) in "-gnatep" | "-gnateD"
then
Preprocessor_Switches.Append (Arg);
-- -h
elsif Arg = "-h" then
Usage_Needed := True;
-- -P
elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-P" then
if File_Set then
Fail ("only one -P switch may be specified");
end if;
if Arg'Length = 2 then
Project_File_Name_Expected := True;
else
File_Set := True;
File_Path := new String'(Arg (3 .. Arg'Last));
end if;
-- -v
elsif Arg = "-v" then
if Opt.Verbose_Mode then
Very_Verbose := True;
else
Opt.Verbose_Mode := True;
Opt.Verbosity_Level := Opt.High;
end if;
-- -vP?
elsif Arg'Length = 4 and then
Arg (1 .. 3) = "-vP" and then
Arg (4) in '0' .. '2'
then
case Arg (4) is
when '0' =>
Current_Verbosity := Default;
when '1' =>
Current_Verbosity := Medium;
when '2' =>
Current_Verbosity := High;
when others =>
null;
end case;
-- -x
elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-x" then
if Arg'Length = 2 then
Excluded_Pattern_Expected := True;
else
Arguments.Reference
(Arguments.Last).Element.Excluded_Patterns.Append
(Arg (3 .. Arg'Last));
Check_Regular_Expression (Arg (3 .. Arg'Last));
end if;
-- -X
elsif Arg'Length >= 3
and then Arg (1 .. 2) = "-X"
and then Is_External_Assignment (Root_Environment, Arg)
then
-- Is_External_Assignment has side effects when it returns True
null;
-- Junk switch starting with minus
elsif Arg (1) = '-' then
Fail ("wrong switch: " & Arg);
-- Not a recognized switch, assume file name
else
declare
File_Name : String := Arg;
begin
Canonical_Case_File_Name (File_Name);
Arguments.Reference
(Arguments.Last).Element.Name_Patterns.Append (File_Name);
Check_Regular_Expression (File_Name);
end;
end if;
end if;
end Scan_Arg;
-----------
-- Usage --
-----------
procedure Usage is
begin
if not Usage_Output then
Usage_Needed := False;
Usage_Output := True;
Put_Line
("Usage: gprname [switches] naming-pattern [naming-patterns]");
Put_Line (" {--and [switches] naming-pattern [naming-patterns]}");
New_Line;
Put_Line ("switches:");
Display_Usage_Version_And_Help;
Put_Line
(" --target= indicates the target of the GNAT compiler");
New_Line;
Put_Line (" --RTS=dir specify the Ada runtime");
Put_Line (" --no-backup do not create backup of project file");
New_Line;
Put_Line (" --ignore-duplicate-files ignore duplicate basenames");
Put_Line (" --ignore-predefined-units ignore predefined units");
New_Line;
Put_Line (" --and use different patterns");
New_Line;
Put_Line (" -ddir use dir as one of the source " &
"directories");
Put_Line (" -Dfile get source directories from file");
Put_Line (" -eL follow symbolic links when processing " &
"project files");
Put_Line (" -fpat pattern for C source");
Put_Line (" -f:lang pat pattern for source of language lang");
Put_Line (" -gnateDsym=v preprocess with symbol definition");
Put_Line (" -gnatep=data preprocess files with data file");
Put_Line (" -h output this help message");
Put_Line (" -Pproj update or create project file proj");
Put_Line (" -v verbose output");
Put_Line (" -v -v very verbose output");
Put_Line (" -vPx " &
"Specify verbosity when parsing Project Files (x = 0/1/2)");
Put_Line (" -xpat exclude pattern pat");
end if;
end Usage;
-- Start of processing for Gnatname
begin
-- Add the external variable GPR_TOOL (default value "gprbuild")
Add_Gpr_Tool_External;
Initialize;
if Opt.Verbose_Mode then
Output_Version;
end if;
if Usage_Needed then
Usage;
end if;
-- If no Ada or foreign pattern was specified, print the usage and return
if Arguments.Last_Element.Name_Patterns.Is_Empty
and then Arguments.Last_Element.Foreign_Sources_Patterns.Is_Empty
then
if Argument_Count = 0 then
Usage;
elsif not Usage_Output then
Try_Help;
end if;
return;
end if;
-- If no source directory was specified, use the current directory as the
-- unique directory. Note that if a file was specified with directory
-- information, the current directory is the directory of the specified
-- file.
if Arguments.Last_Element.Directories.Is_Empty then
Arguments.Reference (Arguments.Last).Element.Directories.Append (".");
end if;
-- Initialize
Initialize
(File_Path => File_Path.all,
Preproc_Switches => Preprocessor_Switches,
Very_Verbose => Very_Verbose,
Flags => Gprname_Flags);
-- Process each section successively
for Arg of Arguments loop
declare
Name_Patterns : Regexp_List;
Excl_Patterns : Regexp_List;
Frgn_Patterns : Foreign_Regexp_List;
begin
for Name of Arg.Name_Patterns loop
Name_Patterns.Append (Compile (Name, Glob => True));
end loop;
for Excl of Arg.Excluded_Patterns loop
Excl_Patterns.Append (Compile (Excl, Glob => True));
end loop;
for Frgn of Arg.Foreign_Sources_Patterns loop
Frgn_Patterns.Append
(Foreign_Regexp'
(Language => Frgn.Language,
Pattern => Compile (Frgn.Pattern, Glob => True)));
end loop;
Process
(Directories => Arg.Directories,
Name_Patterns => Name_Patterns,
Excluded_Patterns => Excl_Patterns,
Foreign_Patterns => Frgn_Patterns);
end;
end loop;
-- Finalize
Finalize;
if Opt.Verbose_Mode then
New_Line;
end if;
Finish_Program (Project_Tree);
end GPRName.Main;