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");
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));
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));
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 --
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
-- 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
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;
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
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;
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
-- 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.
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
declare
CP_File : constant Name_Id := Configuration_Pragmas_File;
+
begin
if CP_File /= No_Name then
if The_Command = Elim then
declare
Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
-
begin
for J in 1 .. First_Switches.Last loop
Test_If_Relative_Path
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;
(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
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);
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 --
----------------------------
--
-- 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
-- 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)
-- 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 --
OSDN Git Service
