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

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

5 files changed, 330 insertions, 42 deletions

diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 3ef1ec7..995f985 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -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);
diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb
index b43fe80..8234d27 100644
--- a/gcc/ada/prj-attr.adb
+++ b/gcc/ada/prj-attr.adb
@@ -161,6 +161,12 @@ package body Prj.Attr is
      "Ladefault_switches#" &
      "Lbswitches#" &
 
+   --  package Check
+
+     "Pcheck#" &
+     "Ladefault_switches#" &
+     "Lbswitches#" &
+
    --  package Eliminate
 
      "Peliminate#" &
diff --git a/gcc/ada/vms_conv.adb b/gcc/ada/vms_conv.adb
index 2157731..b9da2bb 100644
--- a/gcc/ada/vms_conv.adb
+++ b/gcc/ada/vms_conv.adb
@@ -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"),
diff --git a/gcc/ada/vms_conv.ads b/gcc/ada/vms_conv.ads
index 1989381..7f58c28 100644
--- a/gcc/ada/vms_conv.ads
+++ b/gcc/ada/vms_conv.ads
@@ -98,6 +98,7 @@ package VMS_Conv is
       Chop,
       Clean,
       Compile,
+      Check,
       Elim,
       Find,
       Krunch,
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index 9f37b20..d9d4015 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -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 --