procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

gnatcmd.adb (GNATCmd): GNAT CHECK accepts switch -U If GNAT CHECK is called with a project file...

Browse source 
2005-12-05  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb (GNATCmd): GNAT CHECK accepts switch -U
	If GNAT CHECK is called with a project file, but with no
	source on the command line, call gnatcheck with all the compilable
	sources of the project.
	Take into account the new command Check, for gnatcheck. Treat as for
	other ASIS tools: take into account project, specific package Check and
	Compiler switches.
	For ASIS tools, add the switches in package Compiler for
	the invocation of the compiler.

	* prj-attr.adb: Add package Check and its attributes

	* vms_conv.ads (Command_Type): New command Check, for gnatcheck

	* vms_conv.adb (Initialize): Change Params of command Check to
	unlimited files.
	Change some Hostparm.OpenVMS checks to Targparm.OpenVMS_On_Target.
	Add data for new command Check

	* vms_data.ads: Add project related qualifiers for GNAT CHECK and GNAT
	ELIM.
	Add qualifiers for Check command options
	(Command_Type): New command Check

From-SVN: r108297
This commit is contained in:
Vincent Celier 2005-12-09 18:20:15 +01:00 • committed by Arnaud Charlet
parent ee09461671
commit 59ecbd0bdf
5 changed files with 330 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

152
gcc/ada/gnatcmd.adb
View file

@ -106,6 +106,8 @@ procedure GNATCmd is
Naming_String : constant String_Access := new String'("naming");
Binder_String : constant String_Access := new String'("binder");
Compiler_String : constant String_Access := new String'("compiler");
Check_String : constant String_Access := new String'("check");
Eliminate_String : constant String_Access := new String'("eliminate");
Finder_String : constant String_Access := new String'("finder");
Linker_String : constant String_Access := new String'("linker");
@ -118,8 +120,11 @@ procedure GNATCmd is
Packages_To_Check_By_Binder : constant String_List_Access :=
new String_List'((Naming_String, Binder_String));
Packages_To_Check_By_Check : constant String_List_Access :=
new String_List'((Naming_String, Check_String, Compiler_String));
Packages_To_Check_By_Eliminate : constant String_List_Access :=
new String_List'((Naming_String, Eliminate_String));
new String_List'((Naming_String, Eliminate_String, Compiler_String));
Packages_To_Check_By_Finder : constant String_List_Access :=
new String_List'((Naming_String, Finder_String));
@ -131,13 +136,13 @@ procedure GNATCmd is
new String_List'((Naming_String, Gnatls_String));
Packages_To_Check_By_Pretty : constant String_List_Access :=
new String_List'((Naming_String, Pretty_String));
new String_List'((Naming_String, Pretty_String, Compiler_String));
Packages_To_Check_By_Gnatstub : constant String_List_Access :=
new String_List'((Naming_String, Gnatstub_String));
new String_List'((Naming_String, Gnatstub_String, Compiler_String));
Packages_To_Check_By_Metric : constant String_List_Access :=
new String_List'((Naming_String, Metric_String));
new String_List'((Naming_String, Metric_String, Compiler_String));
Packages_To_Check_By_Xref : constant String_List_Access :=
new String_List'((Naming_String, Xref_String));
@ -163,8 +168,8 @@ procedure GNATCmd is
All_Projects : Boolean := False;
-- Flag used for GNAT PRETTY and GNAT METRIC to indicate that
-- the underlying tool (gnatpp or gnatmetric) should be invoked for all
-- sources of all projects.
-- the underlying tool (gnatcheck, gnatpp or gnatmetric) should be invoked
-- for all sources of all projects.
-----------------------
-- Local Subprograms --
@ -345,7 +350,7 @@ procedure GNATCmd is
end if;
else
-- For gnatpp and gnatmetric, put all sources
-- 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
@ -369,7 +374,7 @@ procedure GNATCmd is
-- If the list of files is too long, create a temporary
-- text file that lists these files, and pass this temp
-- file to gnatpp or gnatmetric using switch -files=.
-- file to gnatcheck, gnatpp or gnatmetric using switch -files=.
if Last_Switches.Last - Current_Last >
Max_Files_On_The_Command_Line
@ -1342,7 +1347,7 @@ begin
Exec_Path := Locate_Exec_On_Path (Program);
if Exec_Path = null then
Put_Line (Standard_Error, "Couldn't locate " & Program);
Put_Line (Standard_Error, "could not locate " & Program);
raise Error_Exit;
end if;
@ -1356,10 +1361,11 @@ begin
end loop;
end if;
-- For BIND, FIND, LINK, LIST, PRETTY ad XREF, look for project file
-- related switches.
-- For BIND, CHECK, FIND, LINK, LIST, PRETTY ad XREF, look for project
-- file related switches.
if The_Command = Bind
or else The_Command = Check
or else The_Command = Elim
or else The_Command = Find
or else The_Command = Link
@ -1373,6 +1379,9 @@ begin
when Bind =>
Tool_Package_Name := Name_Binder;
Packages_To_Check := Packages_To_Check_By_Binder;
when Check =>
Tool_Package_Name := Name_Check;
Packages_To_Check := Packages_To_Check_By_Check;
when Elim =>
Tool_Package_Name := Name_Eliminate;
Packages_To_Check := Packages_To_Check_By_Eliminate;
@ -1539,7 +1548,10 @@ begin
Remove_Switch (Arg_Num);
elsif (The_Command = Pretty or else The_Command = Metric)
elsif
(The_Command = Check or else
The_Command = Pretty or else
The_Command = Metric)
and then Argv'Length = 2
and then Argv (2) = 'U'
then
@ -1610,9 +1622,10 @@ begin
-- Packages Binder (for gnatbind), Cross_Reference (for
-- gnatxref), Linker (for gnatlink) Finder (for gnatfind),
-- Pretty_Printer (for gnatpp) Eliminate (for gnatelim) and
-- Metric (for gnatmetric) have an attributed Switches,
-- an associative array, indexed by the name of the file.
-- 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.
@ -1691,16 +1704,92 @@ begin
Prj.Env.Set_Ada_Paths
(Project, Project_Tree, Including_Libraries => False);
-- For gnatstub, gnatmetric, gnatpp and gnatelim, create
-- For gnatcheck, gnatstub, gnatmetric, gnatpp and gnatelim, create
-- a configuration pragmas file, if necessary.
if The_Command = Pretty
or else The_Command = Metric
or else The_Command = Stub
or else The_Command = Elim
or else The_Command = Check
then
-- If -cargs is one of the switches, move the following
-- switches to the Carg_Switches table.
-- If there are switches in package Compiler, put them in the
-- Carg_Switches table.
declare
Data : constant Prj.Project_Data :=
Project_Tree.Projects.Table (Project);
Pkg : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Name_Compiler,
In_Packages => Data.Decl.Packages,
In_Tree => Project_Tree);
Element : Package_Element;
Default_Switches_Array : Array_Element_Id;
The_Switches : Prj.Variable_Value;
Current : Prj.String_List_Id;
The_String : String_Element;
begin
if Pkg /= No_Package then
Element := Project_Tree.Packages.Table (Pkg);
Default_Switches_Array :=
Prj.Util.Value_Of
(Name => Name_Default_Switches,
In_Arrays => Element.Decl.Arrays,
In_Tree => Project_Tree);
The_Switches := Prj.Util.Value_Of
(Index => Name_Ada,
Src_Index => 0,
In_Array => Default_Switches_Array,
In_Tree => Project_Tree);
-- If there are switches specified in the package of the
-- project file corresponding to the tool, scan them.
case The_Switches.Kind is
when Prj.Undefined =>
null;
when Prj.Single =>
declare
Switch : constant String :=
Get_Name_String (The_Switches.Value);
begin
if Switch'Length > 0 then
Add_To_Carg_Switches (new String'(Switch));
end if;
end;
when Prj.List =>
Current := The_Switches.Values;
while Current /= Prj.Nil_String loop
The_String :=
Project_Tree.String_Elements.Table (Current);
declare
Switch : constant String :=
Get_Name_String (The_String.Value);
begin
if Switch'Length > 0 then
Add_To_Carg_Switches (new String'(Switch));
end if;
end;
Current := The_String.Next;
end loop;
end case;
end if;
end;
-- If -cargs is one of the switches, move the following switches
-- to the Carg_Switches table.
for J in 1 .. First_Switches.Last loop
if First_Switches.Table (J).all = "-cargs" then
@ -1724,6 +1813,7 @@ begin
declare
CP_File : constant Name_Id := Configuration_Pragmas_File;
begin
if CP_File /= No_Name then
if The_Command = Elim then
@ -1762,7 +1852,6 @@ begin
declare
Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
begin
for J in 1 .. First_Switches.Last loop
Test_If_Relative_Path
@ -1847,10 +1936,10 @@ begin
end;
end if;
-- For gnatmetric, the generated files should be put in the
-- object directory. This must be the first switch, because it may
-- be overriden by a switch in package Metrics in the project file
-- or by a command line option.
-- For gnatmetric, the generated files should be put in the object
-- directory. This must be the first switch, because it may be
-- overriden by a switch in package Metrics in the project file or by
-- a command line option.
if The_Command = Metric then
First_Switches.Increment_Last;
@ -1863,11 +1952,12 @@ begin
(Project).Object_Directory));
end if;
-- For gnat pretty and gnat metric, if no file has been put on the
-- command line, call the tool with all the sources of the main
-- project.
-- 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.
if The_Command = Pretty or else
if The_Command = Check or else
The_Command = Pretty or else
The_Command = Metric or else
The_Command = List
then
@ -1943,10 +2033,10 @@ exception
Prj.Env.Delete_All_Path_Files (Project_Tree);
Delete_Temp_Config_Files;
-- Since GNATCmd is normally called from DCL (the VMS shell),
-- it must return an understandable VMS exit status. However
-- the exit status returned *to* GNATCmd is a Posix style code,
-- so we test it and return just a simple success or failure on VMS.
-- Since GNATCmd is normally called from DCL (the VMS shell), it must
-- return an understandable VMS exit status. However the exit status
-- returned *to* GNATCmd is a Posix style code, so we test it and return
-- just a simple success or failure on VMS.
if Hostparm.OpenVMS and then My_Exit_Status /= Success then
Set_Exit_Status (Failure);

6
gcc/ada/prj-attr.adb
View file

@ -161,6 +161,12 @@ package body Prj.Attr is
"Ladefault_switches#" &
"Lbswitches#" &
-- package Check
"Pcheck#" &
"Ladefault_switches#" &
"Lbswitches#" &
-- package Eliminate
"Peliminate#" &

15
gcc/ada/vms_conv.adb
View file

@ -27,7 +27,8 @@
with Gnatvsn;
with Hostparm;
with Opt;
with Osint; use Osint;
with Osint; use Osint;
with Targparm; use Targparm;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Command_Line; use Ada.Command_Line;
@ -185,7 +186,7 @@ package body VMS_Conv is
Object_Dirs := Object_Dirs + 1;
Object_Dir (Object_Dirs) := new String'("-lgnat");
if Hostparm.OpenVMS then
if OpenVMS_On_Target then
Object_Dirs := Object_Dirs + 1;
Object_Dir (Object_Dirs) := new String'("-ldecgnat");
end if;
@ -242,6 +243,16 @@ package body VMS_Conv is
Params => new Parameter_Array'(1 => Files_Or_Wildcard),
Defext => " "),
Check =>
(Cname => new S'("CHECK"),
Usage => new S'("GNAT CHECK name /qualifiers"),
VMS_Only => False,
Unixcmd => new S'("gnatcheck"),
Unixsws => null,
Switches => Check_Switches'Access,
Params => new Parameter_Array'(1 => Unlimited_Files),
Defext => " "),
Elim =>
(Cname => new S'("ELIM"),
Usage => new S'("GNAT ELIM name /qualifiers"),

1
gcc/ada/vms_conv.ads
View file

@ -98,6 +98,7 @@ package VMS_Conv is
Chop,
Clean,
Compile,
Check,
Elim,
Find,
Krunch,

198
gcc/ada/vms_data.ads
View file

@ -665,6 +665,145 @@ package VMS_Data is
S_Bind_WarnX 'Access,
S_Bind_Zero 'Access);
-----------------------------
-- Switches for GNAT CHECK --
-----------------------------
S_Check_All : aliased constant S := "/ALL " &
"-a";
-- /NOALL (D)
-- /ALL
--
-- Also check the components of the GNAT run time and process the needed
-- components of the GNAT RTL when building and analyzing the global
-- structure for checking the global rules.
S_Check_Ext : aliased constant S := "/EXTERNAL_REFERENCE=" & '"' &
"-X" & '"';
-- /EXTERNAL_REFERENCE="name=val"
--
-- Specifies an external reference to the project manager. Useful only if
-- /PROJECT_FILE is used.
--
-- Example:
-- /EXTERNAL_REFERENCE="DEBUG=TRUE"
S_Check_Files : aliased constant S := "/FILES=@" &
"-files=@";
-- /FILES=filename
--
-- Take as arguments the files that are listed in the specified
-- text file.
S_Check_Help : aliased constant S := "/HELP " &
"-h";
-- /NOHELP (D)
-- /HELP
--
-- Print information about currently implemented checks.
S_Check_Locs : aliased constant S := "/LOCS " &
"-l";
-- /NOLOCS (D)
-- /LOCS
--
-- Use full source locations referebces in the report file.
S_Check_Mess : aliased constant S := "/MESSAGES_PROJECT_FILE=" &
"DEFAULT " &
"-vP0 " &
"MEDIUM " &
"-vP1 " &
"HIGH " &
"-vP2";
-- /MESSAGES_PROJECT_FILE[=messages-option]
--
-- Specifies the "verbosity" of the parsing of project files.
-- messages-option may be one of the following:
--
-- DEFAULT (D) No messages are output if there is no error or warning.
--
-- MEDIUM A small number of messages are output.
--
-- HIGH A great number of messages are output, most of them not
-- being useful for the user.
S_Check_Project : aliased constant S := "/PROJECT_FILE=<" &
"-P>";
-- /PROJECT_FILE=filename
--
-- Specifies the main project file to be used. The project files rooted
-- at the main project file will be parsed before the invocation of the
-- gnatcheck. The source directories to be searched will be communicated
-- to gnatcheck through logical name ADA_PRJ_INCLUDE_FILE.
S_Check_Quiet : aliased constant S := "/QUIET " &
"-q";
-- /NOQUIET (D)
-- /QUIET
--
-- Work quietly, only output warnings and errors.
S_Check_Sections : aliased constant S := "/SECTIONS= " &
"DEFAULT " &
"-s123 " &
"COMPILER_STYLE " &
"-s1 " &
"BY_RULES " &
"-s2 " &
"BY_FILES_BY_RULES " &
"-s3 ";
-- /SECTIONS[=section-option, section-option, ...]
--
-- Specify what sections should be included into the report file.
-- By default, all three section (diagnises in the format correcponding
-- to compiler error and warning messages, diagnoses grouped by rules and
-- then - by files, diagnoses grouped by files and then - by rules) are
-- included in the report file.
--
-- section-option may be one of the following:
--
-- COMPILER_STYLE Include diagnoses in compile-style format
-- (diagoses are grouped by files, for each file
-- they are ordered according to the references
-- into the source)
-- BY_RULES Include diagnoses grouped first by rules and
-- then by files
-- BY_FILES_BY_RULES Include diagnoses grouped first by files and
-- then by rules
--
-- If one of these options is specified, then the report file contains
-- only sections set by these options
S_Check_Short : aliased constant S := "/SHORT " &
"-s";
-- /NOSHORT (D)
-- /SHORT
--
-- Generate a short form of the report file.
S_Check_Verb : aliased constant S := "/VERBOSE " &
"-v";
-- /NOVERBOSE (D)
-- /VERBOSE
--
-- The version number and copyright notice are output, as well as exact
-- copies of the gnat1 commands spawned to obtain the chop control
-- information.
Check_Switches : aliased constant Switches :=
(S_Check_All 'Access,
S_Check_Ext 'Access,
S_Check_Files 'Access,
S_Check_Help 'Access,
S_Check_Locs 'Access,
S_Check_Mess 'Access,
S_Check_Project 'Access,
S_Check_Quiet 'Access,
S_Check_Sections 'Access,
S_Check_Short 'Access,
S_Check_Verb 'Access);
----------------------------
-- Switches for GNAT CHOP --
----------------------------
@ -2961,6 +3100,16 @@ package VMS_Data is
--
-- Look for source files in the default directory.
S_Elim_Ext : aliased constant S := "/EXTERNAL_REFERENCE=" & '"' &
"-X" & '"';
-- /EXTERNAL_REFERENCE="name=val"
--
-- Specifies an external reference to the project manager. Useful only if
-- /PROJECT_FILE is used.
--
-- Example:
-- /EXTERNAL_REFERENCE="DEBUG=TRUE"
S_Elim_GNATMAKE : aliased constant S := "/GNATMAKE=@" &
"--GNATMAKE=@";
-- /GNATMAKE=path_name
@ -2968,6 +3117,34 @@ package VMS_Data is
-- Instructs GNAT MAKE to use a specific gnatmake instead of one available
-- on the path.
S_Elim_Mess : aliased constant S := "/MESSAGES_PROJECT_FILE=" &
"DEFAULT " &
"-vP0 " &
"MEDIUM " &
"-vP1 " &
"HIGH " &
"-vP2";
-- /MESSAGES_PROJECT_FILE[=messages-option]
--
-- Specifies the "verbosity" of the parsing of project files.
-- messages-option may be one of the following:
--
-- DEFAULT (D) No messages are output if there is no error or warning.
--
-- MEDIUM A small number of messages are output.
--
-- HIGH A great number of messages are output, most of them not
-- being useful for the user.
S_Elim_Project : aliased constant S := "/PROJECT_FILE=<" &
"-P>";
-- /PROJECT_FILE=filename
--
-- Specifies the main project file to be used. The project files rooted
-- at the main project file will be parsed before the invocation of the
-- gnatelim. The source directories to be searched will be communicated
-- to gnatelim through logical name ADA_PRJ_INCLUDE_FILE.
S_Elim_Quiet : aliased constant S := "/QUIET " &
"-q";
-- /NOQUIET (D)
@ -2994,15 +3171,18 @@ package VMS_Data is
-- being processed.
Elim_Switches : aliased constant Switches :=
(S_Elim_All 'Access,
S_Elim_Bind 'Access,
S_Elim_Comp 'Access,
S_Elim_Config 'Access,
S_Elim_Current 'Access,
S_Elim_GNATMAKE'Access,
S_Elim_Quiet 'Access,
S_Elim_Search 'Access,
S_Elim_Verb 'Access);
(S_Elim_All 'Access,
S_Elim_Bind 'Access,
S_Elim_Comp 'Access,
S_Elim_Config 'Access,
S_Elim_Current 'Access,
S_Elim_Ext 'Access,
S_Elim_GNATMAKE'Access,
S_Elim_Mess 'Access,
S_Elim_Project 'Access,
S_Elim_Quiet 'Access,
S_Elim_Search 'Access,
S_Elim_Verb 'Access);
----------------------------
-- Switches for GNAT FIND --