aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/gnatcmd.adb
diff options
context:
space:
mode:
authorJose Ruiz <ruiz@adacore.com>2007-04-06 11:22:40 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2007-04-06 11:22:40 +0200
commitdf777314f1fcc8cce837e8c86c56d60425fe875c (patch)
tree728c0e48acae89c929bea240ac7785541055714d /gcc/ada/gnatcmd.adb
parentcf6ba14a7b33298f8478ce1b42ed8dac21ce4284 (diff)
downloadgcc-df777314f1fcc8cce837e8c86c56d60425fe875c.zip
gcc-df777314f1fcc8cce837e8c86c56d60425fe875c.tar.gz
gcc-df777314f1fcc8cce837e8c86c56d60425fe875c.tar.bz2
gnatcmd.adb (B_Start): Add prefix of binder generated file.
2007-04-06 Jose Ruiz <ruiz@adacore.com> Vincent Celier <celier@adacore.com> * gnatcmd.adb (B_Start): Add prefix of binder generated file. (Stack_String): Add this String that contains the name of the Stack package in the project file. (Packages_To_Check_By_Stack): Add this list that contains the packages to be checked by gnatstack, which are the naming and the stack packages. (Check_Files): If no .ci files were specified for gnatstack we add all the .ci files belonging to the projects, including binder generated files. (Non_VMS_Usage): Document that gnatstack accept project file switches. (GNATCmd): Update the B_Start variable if we are in a VMS environment. Add gnatstack to the list of commands that use project file related switches, and get the single attribute Switches from the stack package in a project file when calling gnatstack. Parse the -U flag for processing files belonging to all projects in the project tree. Remove all processing for command Setup * prj-attr.adb: Add new package Stack with single attribute Switches * vms_conv.ads (Command_Type): Add command Stack. Move to body declarations that are only used in the body: types Item_Id, Translation_Type, Item_Ptr, Item and its subtypes. * vms_conv.adb: (Initialize): Add data for new command Stack. Add declarations moved from the spec: types Item_Id, Translation_Type, Item_Ptr, Item and its subtypes. (Cargs_Buffer): New table (Cargs): New Boolean global variable (Process_Buffer): New procedure to create arguments (Place): Put character in table Buffer or Cargs_Buffer depending on the value of Cargs. (Process_Argument): Set Cargs when processing qualifiers for GNAT COMPILE (VMS_Conversion): Call Process_Buffer for table Buffer and, if it is not empty, for table Cargs_Buffer. (Initialize): Remove component Setup in Command_List From-SVN: r123575
Diffstat (limited to 'gcc/ada/gnatcmd.adb')
-rw-r--r--gcc/ada/gnatcmd.adb526
1 files changed, 268 insertions, 258 deletions
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 8eb1563..d503a0c 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -29,6 +29,7 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with Csets;
with MLib.Tgt; use MLib.Tgt;
with MLib.Utl;
+with MLib.Fil;
with Namet; use Namet;
with Opt; use Opt;
with Osint; use Osint;
@@ -60,6 +61,9 @@ procedure GNATCmd is
Current_Verbosity : Prj.Verbosity := Prj.Default;
Tool_Package_Name : Name_Id := No_Name;
+ B_Start : String_Ptr := new String'("b~");
+ -- Prefix of binder generated file, changed to b__ for VMS
+
Old_Project_File_Used : Boolean := False;
-- This flag indicates a switch -p (for gnatxref and gnatfind) for
-- an old fashioned project file. -p cannot be used in conjonction
@@ -120,6 +124,7 @@ procedure GNATCmd is
Linker_String : constant String_Access := new String'("linker");
Gnatls_String : constant String_Access := new String'("gnatls");
Pretty_String : constant String_Access := new String'("pretty_printer");
+ Stack_String : constant String_Access := new String'("stack");
Gnatstub_String : constant String_Access := new String'("gnatstub");
Metric_String : constant String_Access := new String'("metrics");
Xref_String : constant String_Access := new String'("cross_reference");
@@ -145,6 +150,9 @@ procedure GNATCmd is
Packages_To_Check_By_Pretty : constant String_List_Access :=
new String_List'((Naming_String, Pretty_String, Compiler_String));
+ Packages_To_Check_By_Stack : constant String_List_Access :=
+ new String_List'((Naming_String, Stack_String));
+
Packages_To_Check_By_Gnatstub : constant String_List_Access :=
new String_List'((Naming_String, Gnatstub_String, Compiler_String));
@@ -174,54 +182,52 @@ procedure GNATCmd is
-- The path of the working directory
All_Projects : Boolean := False;
- -- Flag used for GNAT PRETTY and GNAT METRIC to indicate that
- -- the underlying tool (gnatcheck, gnatpp or gnatmetric) should be invoked
- -- for all sources of all projects.
+ -- Flag used for GNAT CHECK, GNAT PRETTY, GNAT METRIC, and GNAT STACK to
+ -- indicate that the underlying tool (gnatcheck, gnatpp or gnatmetric)
+ -- should be invoked for all sources of all projects.
-----------------------
-- Local Subprograms --
-----------------------
procedure Add_To_Carg_Switches (Switch : String_Access);
- -- Add a switch to the Carg_Switches table. If it is the first one,
- -- put the switch "-cargs" at the beginning of the table.
+ -- Add a switch to the Carg_Switches table. If it is the first one, put the
+ -- switch "-cargs" at the beginning of the table.
procedure Add_To_Rules_Switches (Switch : String_Access);
- -- Add a switch to the Rules_Switches table. If it is the first one,
- -- put the switch "-crules" at the beginning of the table.
+ -- Add a switch to the Rules_Switches table. If it is the first one, put
+ -- the switch "-crules" at the beginning of the table.
procedure Check_Files;
- -- For GNAT LIST, GNAT PRETTY and GNAT METRIC, check if a project
- -- file is specified, without any file arguments. If it is the case,
- -- invoke the GNAT tool with the proper list of files, derived from
+ -- For GNAT LIST, GNAT PRETTY, GNAT METRIC, and GNAT STACK, check if a
+ -- project file is specified, without any file arguments. If it is the
+ -- case, invoke the GNAT tool with the proper list of files, derived from
-- the sources of the project.
function Check_Project
(Project : Project_Id;
Root_Project : Project_Id) return Boolean;
- -- Returns True if Project = Root_Project.
- -- For GNAT METRIC, also returns True if Project is extended by
- -- Root_Project.
+ -- Returns True if Project = Root_Project or if we want to consider all
+ -- sources of all projects. For GNAT METRIC, also returns True if Project
+ -- is extended by Root_Project.
procedure Check_Relative_Executable (Name : in out String_Access);
- -- Check if an executable is specified as a relative path.
- -- If it is, and the path contains directory information, fail.
- -- Otherwise, prepend the exec directory.
- -- This procedure is only used for GNAT LINK when a project file
- -- is specified.
+ -- Check if an executable is specified as a relative path. If it is, and
+ -- the path contains directory information, fail. Otherwise, prepend the
+ -- exec directory. This procedure is only used for GNAT LINK when a project
+ -- file is specified.
function Configuration_Pragmas_File return Name_Id;
-- Return an argument, if there is a configuration pragmas file to be
- -- specified for Project, otherwise return No_Name.
- -- Used for gnatstub (GNAT STUB), gnatpp (GNAT PRETTY), gnatelim
- -- (GNAT ELIM), and gnatmetric (GNAT METRIC).
+ -- specified for Project, otherwise return No_Name. Used for gnatstub (GNAT
+ -- STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric (GNAT
+ -- METRIC).
procedure Delete_Temp_Config_Files;
-- Delete all temporary config files
function Index (Char : Character; Str : String) return Natural;
- -- Returns the first occurrence of Char in Str.
- -- Returns 0 if Char is not in Str.
+ -- Returns first occurrence of Char in Str, returns 0 if Char not in Str
procedure Non_VMS_Usage;
-- Display usage for platforms other than VMS
@@ -232,20 +238,20 @@ procedure GNATCmd is
procedure Set_Library_For
(Project : Project_Id;
There_Are_Libraries : in out Boolean);
- -- If Project is a library project, add the correct
- -- -L and -l switches to the linker invocation.
+ -- If Project is a library project, add the correct -L and -l switches to
+ -- the linker invocation.
procedure Set_Libraries is
new For_Every_Project_Imported (Boolean, Set_Library_For);
- -- Add the -L and -l switches to the linker for all
- -- of the library projects.
+ -- Add the -L and -l switches to the linker for all of the library
+ -- projects.
procedure Test_If_Relative_Path
(Switch : in out String_Access;
Parent : String);
- -- Test if Switch is a relative search path switch.
- -- If it is and it includes directory information, prepend the path with
- -- Parent.This subprogram is only called when using project files.
+ -- Test if Switch is a relative search path switch. If it is and it
+ -- includes directory information, prepend the path with Parent. This
+ -- subprogram is only called when using project files.
--------------------------
-- Add_To_Carg_Switches --
@@ -300,27 +306,89 @@ procedure GNATCmd is
end if;
end loop;
- -- If all arguments were switches, add the path names of
- -- all the sources of the main project.
+ -- If all arguments were switches, add the path names of all the sources
+ -- of the main project.
if Add_Sources then
declare
Current_Last : constant Integer := Last_Switches.Last;
begin
+ -- Gnatstack needs to add the the .ci file for the binder
+ -- generated files corresponding to all of the library projects
+ -- and main units belonging to the application.
+
+ if The_Command = Stack then
+ for Proj in Project_Table.First ..
+ Project_Table.Last (Project_Tree.Projects)
+ loop
+ if Check_Project (Proj, Project) then
+ declare
+ Data : Project_Data renames
+ Project_Tree.Projects.Table (Proj);
+ Main : String_List_Id := Data.Mains;
+ File : String_Access;
+
+ begin
+ -- Include binder generated files for main programs
+
+ while Main /= Nil_String loop
+ File :=
+ new String'
+ (Get_Name_String (Data.Object_Directory) &
+ Directory_Separator &
+ B_Start.all &
+ MLib.Fil.Ext_To
+ (Get_Name_String
+ (Project_Tree.String_Elements.Table
+ (Main).Value),
+ "ci"));
+
+ if Is_Regular_File (File.all) then
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) := File;
+ end if;
+
+ Main :=
+ Project_Tree.String_Elements.Table (Main).Next;
+ end loop;
+
+ if Data.Library then
+
+ -- Include the .ci file for the binder generated
+ -- files that contains the initialization and
+ -- finalization of the library.
+
+ File :=
+ new String'
+ (Get_Name_String (Data.Object_Directory) &
+ Directory_Separator &
+ B_Start.all &
+ Get_Name_String (Data.Library_Name) &
+ ".ci");
+
+ if Is_Regular_File (File.all) then
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) := File;
+ end if;
+ end if;
+ end;
+ end if;
+ end loop;
+ end if;
+
for Unit in Unit_Table.First ..
Unit_Table.Last (Project_Tree.Units)
loop
Unit_Data := Project_Tree.Units.Table (Unit);
- -- For gnatls, we only need to put the library units,
- -- body or spec, but not the subunits.
+ -- For gnatls, we only need to put the library units, body or
+ -- spec, but not the subunits.
if The_Command = List then
if
Unit_Data.File_Names (Body_Part).Name /= No_Name
then
- -- There is a body; check if it is for this
- -- project.
+ -- There is a body, check if it is for this project
if Unit_Data.File_Names (Body_Part).Project =
Project
@@ -330,9 +398,9 @@ procedure GNATCmd is
if Unit_Data.File_Names (Specification).Name =
No_Name
then
- -- We have a body with no spec: we need
- -- to check if this is a subunit, because
- -- gnatls will complain about subunits.
+ -- We have a body with no spec: we need to check if
+ -- this is a subunit, because gnatls will complain
+ -- about subunits.
declare
Src_Ind : Source_File_Index;
@@ -359,11 +427,11 @@ procedure GNATCmd is
end if;
end if;
- elsif Unit_Data.File_Names (Specification).Name /=
- No_Name
+ elsif
+ Unit_Data.File_Names (Specification).Name /= No_Name
then
- -- We have a spec with no body; check if it is
- -- for this project.
+ -- We have a spec with no body; check if it is for this
+ -- project.
if Unit_Data.File_Names (Specification).Project =
Project
@@ -377,14 +445,97 @@ procedure GNATCmd is
end if;
end if;
+ -- For gnatstack, we put the .ci files corresponding to the
+ -- different units, including the binder generated files. We
+ -- only need to do that for the library units, body or spec,
+ -- but not the subunits.
+
+ elsif The_Command = Stack then
+ if
+ Unit_Data.File_Names (Body_Part).Name /= No_Name
+ then
+ -- There is a body. Check if .ci files for this project
+ -- must be added.
+
+ if
+ Check_Project
+ (Unit_Data.File_Names (Body_Part).Project, Project)
+ then
+ Subunit := False;
+
+ if
+ Unit_Data.File_Names (Specification).Name = No_Name
+ then
+ -- We have a body with no spec: we need to check
+ -- if this is a subunit, because .ci files are not
+ -- generated for subunits.
+
+ declare
+ Src_Ind : Source_File_Index;
+
+ begin
+ Src_Ind := Sinput.P.Load_Project_File
+ (Get_Name_String
+ (Unit_Data.File_Names (Body_Part).Path));
+
+ Subunit :=
+ Sinput.P.Source_File_Is_Subunit (Src_Ind);
+ end;
+ end if;
+
+ if not Subunit then
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) :=
+ new String'
+ (Get_Name_String
+ (Project_Tree.Projects.Table
+ (Unit_Data.File_Names
+ (Body_Part).Project).
+ Object_Directory) &
+ Directory_Separator &
+ MLib.Fil.Ext_To
+ (Get_Name_String
+ (Unit_Data.File_Names
+ (Body_Part).Display_Name),
+ "ci"));
+ end if;
+ end if;
+
+ elsif
+ Unit_Data.File_Names (Specification).Name /= No_Name
+ then
+ -- We have a spec with no body. Check if it is for this
+ -- project.
+
+ if
+ Check_Project
+ (Unit_Data.File_Names (Specification).Project,
+ Project)
+ then
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) :=
+ new String'
+ (Get_Name_String
+ (Project_Tree.Projects.Table
+ (Unit_Data.File_Names
+ (Specification).Project).
+ Object_Directory) &
+ Dir_Separator &
+ MLib.Fil.Ext_To
+ (Get_Name_String
+ (Unit_Data.File_Names
+ (Specification).Name),
+ "ci"));
+ end if;
+ end if;
+
else
-- For gnatcheck, gnatpp and gnatmetric, put all sources
-- of the project, or of all projects if -U was specified.
for Kind in Spec_Or_Body loop
- -- Put only sources that belong to the main
- -- project.
+ -- Put only sources that belong to the main project
if Check_Project
(Unit_Data.File_Names (Kind).Project, Project)
@@ -400,9 +551,9 @@ procedure GNATCmd is
end if;
end loop;
- -- If the list of files is too long, create a temporary
- -- text file that lists these files, and pass this temp
- -- file to gnatcheck, gnatpp or gnatmetric using switch -files=.
+ -- If the list of files is too long, create a temporary text file
+ -- that lists these files, and pass this temp file to gnatcheck,
+ -- gnatpp or gnatmetric using switch -files=.
if Last_Switches.Last - Current_Last >
Max_Files_On_The_Command_Line
@@ -421,8 +572,7 @@ procedure GNATCmd is
Last_Switches.Last
loop
Len := Last_Switches.Table (Index)'Length;
- Buffer (1 .. Len) :=
- Last_Switches.Table (Index).all;
+ Buffer (1 .. Len) := Last_Switches.Table (Index).all;
Len := Len + 1;
Buffer (Len) := ASCII.LF;
Buffer (Len + 1) := ASCII.NUL;
@@ -440,13 +590,12 @@ procedure GNATCmd is
OK := False;
end if;
- -- If there were any problem creating the temp
- -- file, then pass the list of files.
+ -- If there were any problem creating the temp file, then
+ -- pass the list of files.
if OK then
- -- Replace the list of files with
- -- "-files=<temp file name>".
+ -- Replace list of files with -files=<temp file name>
Last_Switches.Set_Last (Current_Last + 1);
Last_Switches.Table (Last_Switches.Last) :=
@@ -476,10 +625,10 @@ procedure GNATCmd is
elsif The_Command = Metric then
declare
- Data : Project_Data :=
- Project_Tree.Projects.Table (Root_Project);
+ Data : Project_Data;
begin
+ Data := Project_Tree.Projects.Table (Root_Project);
while Data.Extends /= No_Project loop
if Project = Data.Extends then
return True;
@@ -601,14 +750,14 @@ procedure GNATCmd is
------------------
procedure Process_Link is
- Look_For_Executable : Boolean := True;
- There_Are_Libraries : Boolean := False;
- Path_Option : constant String_Access :=
- MLib.Linker_Library_Path_Option;
- Prj : Project_Id := Project;
- Arg : String_Access;
- Last : Natural := 0;
- Skip_Executable : Boolean := False;
+ Look_For_Executable : Boolean := True;
+ There_Are_Libraries : Boolean := False;
+ Path_Option : constant String_Access :=
+ MLib.Linker_Library_Path_Option;
+ Prj : Project_Id := Project;
+ Arg : String_Access;
+ Last : Natural := 0;
+ Skip_Executable : Boolean := False;
begin
-- Add the default search directories, to be able to find
@@ -640,9 +789,9 @@ procedure GNATCmd is
Last_Switches.Table (Last_Switches.Last) :=
new String'("-lgnat");
- -- If Path_Option is not null, create the switch
- -- ("-Wl,-rpath," or equivalent) with all the library dirs
- -- plus the standard GNAT library dir.
+ -- If Path_Option is not null, create the switch ("-Wl,-rpath," or
+ -- equivalent) with all the library dirs plus the standard GNAT
+ -- library dir.
if Path_Option /= null then
declare
@@ -656,16 +805,15 @@ procedure GNATCmd is
for Index in
Library_Paths.First .. Library_Paths.Last
loop
- -- Add the length of the library dir plus one
- -- for the directory separator.
+ -- Add the length of the library dir plus one for the
+ -- directory separator.
Length :=
Length +
Library_Paths.Table (Index)'Length + 1;
end loop;
- -- Finally, add the length of the standard GNAT
- -- library dir.
+ -- Finally, add the length of the standard GNAT library dir
Length := Length + MLib.Utl.Lib_Directory'Length;
Option := new String (1 .. Length);
@@ -704,11 +852,10 @@ procedure GNATCmd is
end if;
end if;
- -- Check if the first ALI file specified can be found, either
- -- in the object directory of the main project or in an object
- -- directory of a project file extended by the main project.
- -- If the ALI file can be found, replace its name with its
- -- absolute path.
+ -- Check if the first ALI file specified can be found, either in the
+ -- object directory of the main project or in an object directory of a
+ -- project file extended by the main project. If the ALI file can be
+ -- found, replace its name with its absolute path.
Skip_Executable := False;
@@ -753,8 +900,8 @@ procedure GNATCmd is
Last := ALI_File'Last;
end if;
- -- If file name includes directory information,
- -- stop if ALI file exists.
+ -- If file name includes directory information, stop if ALI
+ -- file exists.
if Is_Absolute_Path (ALI_File (1 .. Last)) then
Test_Existence := True;
@@ -804,8 +951,7 @@ procedure GNATCmd is
end if;
end;
- -- Go to the project being extended,
- -- if any.
+ -- Go to the project being extended, if any
Prj :=
Project_Tree.Projects.Table (Prj).Extends;
@@ -817,8 +963,8 @@ procedure GNATCmd is
end if;
end loop Switch_Loop;
- -- If a relative path output file has been specified, we add
- -- the exec directory.
+ -- If a relative path output file has been specified, we add the exec
+ -- directory.
for J in reverse 1 .. Last_Switches.Last - 1 loop
if Last_Switches.Table (J).all = "-o" then
@@ -840,10 +986,9 @@ procedure GNATCmd is
end loop;
end if;
- -- If no executable is specified, then find the name
- -- of the first ALI file on the command line and issue
- -- a -o switch with the absolute path of the executable
- -- in the exec directory.
+ -- If no executable is specified, then find the name of the first ALI
+ -- file on the command line and issue a -o switch with the absolute path
+ -- of the executable in the exec directory.
if Look_For_Executable then
for J in 1 .. Last_Switches.Last loop
@@ -1030,8 +1175,8 @@ procedure GNATCmd is
end loop;
New_Line;
- Put_Line ("Commands find, list, metric, pretty, stub and xref accept " &
- "project file switches -vPx, -Pprj and -Xnam=val");
+ Put_Line ("Commands find, list, metric, pretty, stack, stub and xref " &
+ "accept project file switches -vPx, -Pprj and -Xnam=val");
New_Line;
end Non_VMS_Usage;
@@ -1061,10 +1206,9 @@ begin
VMS_Conv.Initialize;
- -- Add the directory where the GNAT driver is invoked in front of the
- -- path, if the GNAT driver is invoked with directory information.
- -- Only do this if the platform is not VMS, where the notion of path
- -- does not really exist.
+ -- Add the directory where the GNAT driver is invoked in front of the path,
+ -- if the GNAT driver is invoked with directory information. Do not do this
+ -- for VMS, where the notion of path does not really exist.
if not OpenVMS then
declare
@@ -1101,6 +1245,8 @@ begin
then
VMS_Conversion (The_Command);
+ B_Start := new String'("b__");
+
-- If not on VMS, scan the command line directly
else
@@ -1193,8 +1339,8 @@ begin
raise Error_Exit;
end;
- -- Read line by line and put the content of each
- -- non empty line in the Last_Switches table.
+ -- Read line by line and put the content of each non-
+ -- empty line in the Last_Switches table.
while not End_Of_File (Arg_File) loop
Get_Line (Arg_File, Line, Last);
@@ -1229,149 +1375,6 @@ begin
Exec_Path : String_Access;
begin
- -- First deal with built-in command(s)
-
- if The_Command = Setup then
- Process_Setup :
- declare
- Arg_Num : Positive := 1;
- Argv : String_Access;
-
- begin
- while Arg_Num <= Last_Switches.Last loop
- Argv := Last_Switches.Table (Arg_Num);
-
- if Argv (Argv'First) /= '-' then
- Fail ("invalid parameter """, Argv.all, """");
-
- else
- if Argv'Length = 1 then
- Fail
- ("switch character cannot be followed by a blank");
- end if;
-
- -- -vPx Specify verbosity while parsing project files
-
- if Argv'Length = 4
- and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
- then
- case Argv (Argv'Last) is
- when '0' =>
- Current_Verbosity := Prj.Default;
- when '1' =>
- Current_Verbosity := Prj.Medium;
- when '2' =>
- Current_Verbosity := Prj.High;
- when others =>
- Fail ("Invalid switch: ", Argv.all);
- end case;
-
- -- -Pproject_file Specify project file to be used
-
- elsif Argv (Argv'First + 1) = 'P' then
-
- -- Only one -P switch can be used
-
- if Project_File /= null then
- Fail
- (Argv.all,
- ": second project file forbidden (first is """,
- Project_File.all & """)");
-
- elsif Argv'Length = 2 then
-
- -- There is space between -P and the project file
- -- name. -P cannot be the last option.
-
- if Arg_Num = Last_Switches.Last then
- Fail ("project file name missing after -P");
-
- else
- Arg_Num := Arg_Num + 1;
- Argv := Last_Switches.Table (Arg_Num);
-
- -- After -P, there must be a project file name,
- -- not another switch.
-
- if Argv (Argv'First) = '-' then
- Fail ("project file name missing after -P");
-
- else
- Project_File := new String'(Argv.all);
- end if;
- end if;
-
- else
- -- No space between -P and project file name
-
- Project_File :=
- new String'(Argv (Argv'First + 2 .. Argv'Last));
- end if;
-
- -- -Xexternal=value Specify an external reference to be
- -- used in project files
-
- elsif Argv'Length >= 5
- and then Argv (Argv'First + 1) = 'X'
- then
- declare
- Equal_Pos : constant Natural :=
- Index ('=', Argv (Argv'First + 2 .. Argv'Last));
- begin
- if Equal_Pos >= Argv'First + 3 and then
- Equal_Pos /= Argv'Last then
- Add
- (External_Name =>
- Argv (Argv'First + 2 .. Equal_Pos - 1),
- Value => Argv (Equal_Pos + 1 .. Argv'Last));
- else
- Fail
- (Argv.all,
- " is not a valid external assignment.");
- end if;
- end;
-
- elsif Argv.all = "-v" then
- Verbose_Mode := True;
-
- elsif Argv.all = "-q" then
- Quiet_Output := True;
-
- else
- Fail ("invalid parameter """, Argv.all, """");
- end if;
- end if;
-
- Arg_Num := Arg_Num + 1;
- end loop;
-
- if Project_File = null then
- Fail ("no project file specified");
- end if;
-
- Setup_Projects := True;
-
- Prj.Pars.Set_Verbosity (To => Current_Verbosity);
-
- -- Missing directories are created during processing of the
- -- project tree.
-
- Prj.Pars.Parse
- (Project => Project,
- In_Tree => Project_Tree,
- Project_File_Name => Project_File.all,
- Packages_To_Check => All_Packages);
-
- if Project = Prj.No_Project then
- Fail ("""", Project_File.all, """ processing failed");
- end if;
-
- -- Processing is done
-
- return;
- end Process_Setup;
- end if;
-
-- Locate the executable for the command
Exec_Path := Locate_Exec_On_Path (Program);
@@ -1391,8 +1394,8 @@ begin
end loop;
end if;
- -- For BIND, CHECK, FIND, LINK, LIST, PRETTY ad XREF, look for project
- -- file related switches.
+ -- For BIND, CHECK, ELIM, FIND, LINK, LIST, PRETTY, STACK, STUB,
+ -- METRIC ad XREF, look for project file related switches.
if The_Command = Bind
or else The_Command = Check
@@ -1402,6 +1405,7 @@ begin
or else The_Command = List
or else The_Command = Xref
or else The_Command = Pretty
+ or else The_Command = Stack
or else The_Command = Stub
or else The_Command = Metric
then
@@ -1430,6 +1434,9 @@ begin
when Pretty =>
Tool_Package_Name := Name_Pretty_Printer;
Packages_To_Check := Packages_To_Check_By_Pretty;
+ when Stack =>
+ Tool_Package_Name := Name_Stack;
+ Packages_To_Check := Packages_To_Check_By_Stack;
when Stub =>
Tool_Package_Name := Name_Gnatstub;
Packages_To_Check := Packages_To_Check_By_Gnatstub;
@@ -1440,8 +1447,8 @@ begin
null;
end case;
- -- Check that the switches are consistent.
- -- Detect project file related switches.
+ -- Check that the switches are consistent. Detect project file
+ -- related switches.
Inspect_Switches :
declare
@@ -1562,7 +1569,9 @@ begin
then
declare
Equal_Pos : constant Natural :=
- Index ('=', Argv (Argv'First + 2 .. Argv'Last));
+ Index
+ ('=',
+ Argv (Argv'First + 2 .. Argv'Last));
begin
if Equal_Pos >= Argv'First + 3 and then
Equal_Pos /= Argv'Last then
@@ -1581,7 +1590,8 @@ begin
elsif
(The_Command = Check or else
The_Command = Pretty or else
- The_Command = Metric)
+ The_Command = Metric or else
+ The_Command = Stack)
and then Argv'Length = 2
and then Argv (2) = 'U'
then
@@ -1640,10 +1650,10 @@ begin
if Pkg /= No_Package then
Element := Project_Tree.Packages.Table (Pkg);
- -- Packages Gnatls has a single attribute Switches, that is
- -- not an associative array.
+ -- Packages Gnatls and Gnatstack have a single attribute
+ -- Switches, that is not an associative array.
- if The_Command = List then
+ if The_Command = List or else The_Command = Stack then
The_Switches :=
Prj.Util.Value_Of
(Variable_Name => Snames.Name_Switches,
@@ -1651,14 +1661,14 @@ begin
In_Tree => Project_Tree);
-- Packages Binder (for gnatbind), Cross_Reference (for
- -- gnatxref), Linker (for gnatlink) Finder (for gnatfind),
- -- Pretty_Printer (for gnatpp) Eliminate (for gnatelim),
- -- Check (for gnatcheck) and Metric (for gnatmetric) have
- -- an attributed Switches, an associative array, indexed
- -- by the name of the file.
+ -- gnatxref), Linker (for gnatlink), Finder (for gnatfind),
+ -- Pretty_Printer (for gnatpp), Eliminate (for gnatelim), Check
+ -- (for gnatcheck), and Metric (for gnatmetric) have an
+ -- attributed Switches, an associative array, indexed by the
+ -- name of the file.
- -- They also have an attribute Default_Switches, indexed
- -- by the name of the programming language.
+ -- They also have an attribute Default_Switches, indexed by the
+ -- name of the programming language.
else
if The_Switches.Kind = Prj.Undefined then
@@ -1790,7 +1800,6 @@ begin
declare
Switch : constant String :=
Get_Name_String (The_Switches.Value);
-
begin
if Switch'Length > 0 then
Add_To_Carg_Switches (new String'(Switch));
@@ -2031,14 +2040,15 @@ begin
end;
end if;
- -- For gnat check, gnat pretty, gnat metric ands gnat list,
- -- if no file has been put on the command line, call tool with all
- -- the sources of the main project.
+ -- For gnat check, gnat pretty, gnat metric, gnat list, and gnat
+ -- stack, if no file has been put on the command line, call tool
+ -- with all the sources of the main project.
if The_Command = Check or else
The_Command = Pretty or else
The_Command = Metric or else
- The_Command = List
+ The_Command = List or else
+ The_Command = Stack
then
Check_Files;
end if;