Patchwork [Ada] gnatbind: improve messages in -v mode

login
register
mail settings
Submitter Arnaud Charlet
Date April 24, 2013, 1:08 p.m.
Message ID <20130424130838.GA7761@adacore.com>
Download mbox | patch
Permalink /patch/239202/
State New
Headers show

Comments

Arnaud Charlet - April 24, 2013, 1:08 p.m.
This patch improves the messages that get printed by gnatbind when it is
invoked with the -v switch.

Tested on x86_64-pc-linux-gnu, committed on trunk

2013-04-24  Bob Duff  <duff@adacore.com>

	* ali-util.ads (Source_Record): New component Stamp_File
	to record from whence the Stamp came.
	* ali-util.adb (Set_Source_Table): Set Stamp_File component.
	* bcheck.adb (Check_Consistency): Print additional information in
	Verbose_Mode.
	* gnatbind.adb (Gnatbind): Print additional information in
	Verbose_Mode.

Patch

Index: ali-util.adb
===================================================================
--- ali-util.adb	(revision 198221)
+++ ali-util.adb	(working copy)
@@ -35,6 +35,8 @@ 
 with Stringt;
 with Styleg;
 
+with System.OS_Lib; use System.OS_Lib;
+
 package body ALI.Util is
 
    --  Empty procedures needed to instantiate Scng. Error procedures are
@@ -359,6 +361,7 @@ 
                   if Stamp (Stamp'First) /= ' ' then
                      Source.Table (S).Stamp := Stamp;
                      Source.Table (S).Source_Found := True;
+                     Source.Table (S).Stamp_File := F;
 
                   --  If we could not find the file, then the stamp is set
                   --  from the dependency table entry (to be possibly reset
@@ -367,6 +370,7 @@ 
                   else
                      Source.Table (S).Stamp := Sdep.Table (D).Stamp;
                      Source.Table (S).Source_Found := False;
+                     Source.Table (S).Stamp_File := ALIs.Table (A).Afile;
 
                      --  In All_Sources mode, flag error of file not found
 
@@ -380,8 +384,9 @@ 
                --  is off, so simply initialize the stamp from the Sdep entry
 
                else
+                  Source.Table (S).Stamp := Sdep.Table (D).Stamp;
                   Source.Table (S).Source_Found := False;
-                  Source.Table (S).Stamp := Sdep.Table (D).Stamp;
+                  Source.Table (S).Stamp_File := ALIs.Table (A).Afile;
                end if;
 
             --  Here if this is not the first time for this source file,
@@ -407,13 +412,19 @@ 
                   --  source file even if Check_Source_Files is false, since
                   --  if we find it, then we can use it to resolve which of the
                   --  two timestamps in the ALI files is likely to be correct.
+                  --  We only look in the current directory, because when
+                  --  Check_Source_Files is false, other search directories are
+                  --  likely to be incorrect.
 
-                  if not Check_Source_Files then
+                  if not Check_Source_Files
+                    and then Is_Regular_File (Get_Name_String (F))
+                  then
                      Stamp := Source_File_Stamp (F);
 
                      if Stamp (Stamp'First) /= ' ' then
                         Source.Table (S).Stamp := Stamp;
                         Source.Table (S).Source_Found := True;
+                        Source.Table (S).Stamp_File := F;
                      end if;
                   end if;
 
@@ -432,6 +443,7 @@ 
                   else
                      if Sdep.Table (D).Stamp > Source.Table (S).Stamp then
                         Source.Table (S).Stamp := Sdep.Table (D).Stamp;
+                        Source.Table (S).Stamp_File := ALIs.Table (A).Afile;
                      end if;
                   end if;
                end if;
Index: ali-util.ads
===================================================================
--- ali-util.ads	(revision 198221)
+++ ali-util.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT 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- --
@@ -57,6 +57,13 @@ 
       --  located and the Stamp value was set from the actual source file.
       --  It is always false if Check_Source_Files is not set.
 
+      Stamp_File : File_Name_Type;
+      --  File that Stamp came from. If Source_Found is True, then Stamp is the
+      --  timestamp of the source file, and this is the name of the source
+      --  file. If Source_Found is False, then Stamp comes from a dependency
+      --  line in an ALI file, this is the name of that ALI file. Used only in
+      --  verbose mode, for messages.
+
       All_Timestamps_Match : Boolean;
       --  This flag is set only if all files referencing this source file
       --  have a matching time stamp, and also, if Source_Found is True,
Index: gnatbind.adb
===================================================================
--- gnatbind.adb	(revision 198221)
+++ gnatbind.adb	(working copy)
@@ -73,7 +73,6 @@ 
    --  Standard library
 
    Text     : Text_Buffer_Ptr;
-   Next_Arg : Positive;
 
    Output_File_Name_Seen : Boolean := False;
    Output_File_Name      : String_Ptr := new String'("");
@@ -104,6 +103,15 @@ 
    --  All the one character arguments are still handled by Switch. This
    --  routine handles -aO -aI and -I-. The lower bound of Argv must be 1.
 
+   generic
+      with procedure Action (Argv : String);
+   procedure Generic_Scan_Bind_Args;
+   --  Iterate through the args calling Action on each one, taking care of
+   --  response files.
+
+   procedure Write_Arg (S : String);
+   --  Passed to Generic_Scan_Bind_Args to print args
+
    function Is_Cross_Compiler return Boolean;
    --  Returns True iff this is a cross-compiler
 
@@ -480,12 +488,64 @@ 
       end if;
    end Scan_Bind_Arg;
 
+   ----------------------------
+   -- Generic_Scan_Bind_Args --
+   ----------------------------
+
+   procedure Generic_Scan_Bind_Args is
+      Next_Arg : Positive := 1;
+   begin
+      --  Use low level argument routines to avoid dragging in the secondary
+      --  stack
+
+      while Next_Arg < Arg_Count loop
+         declare
+            Next_Argv : String (1 .. Len_Arg (Next_Arg));
+         begin
+            Fill_Arg (Next_Argv'Address, Next_Arg);
+
+            if Next_Argv'Length > 0 then
+               if Next_Argv (1) = '@' then
+                  if Next_Argv'Length > 1 then
+                     declare
+                        Arguments : constant Argument_List :=
+                                      Response_File.Arguments_From
+                                        (Response_File_Name        =>
+                                           Next_Argv (2 .. Next_Argv'Last),
+                                         Recursive                 => True,
+                                         Ignore_Non_Existing_Files => True);
+                     begin
+                        for J in Arguments'Range loop
+                           Action (Arguments (J).all);
+                        end loop;
+                     end;
+                  end if;
+
+               else
+                  Action (Next_Argv);
+               end if;
+            end if;
+         end;
+
+         Next_Arg := Next_Arg + 1;
+      end loop;
+   end Generic_Scan_Bind_Args;
+
+   procedure Write_Arg (S : String) is
+   begin
+      Write_Str (" " & S);
+   end Write_Arg;
+
+   procedure Scan_Bind_Args is new Generic_Scan_Bind_Args (Scan_Bind_Arg);
+   procedure Put_Bind_Args is new Generic_Scan_Bind_Args (Write_Arg);
+
    procedure Check_Version_And_Help is
      new Check_Version_And_Help_G (Bindusg.Display);
 
 --  Start of processing for Gnatbind
 
 begin
+
    --  Set default for Shared_Libgnat option
 
    declare
@@ -510,41 +570,17 @@ 
 
    Check_Version_And_Help ("GNATBIND", "1995");
 
-   --  Use low level argument routines to avoid dragging in the secondary stack
+   --  We need to Scan_Bind_Args first, to set Verbose_Mode, so we know whether
+   --  to Put_Bind_Args.
 
-   Next_Arg := 1;
-   Scan_Args : while Next_Arg < Arg_Count loop
-      declare
-         Next_Argv : String (1 .. Len_Arg (Next_Arg));
-      begin
-         Fill_Arg (Next_Argv'Address, Next_Arg);
+   Scan_Bind_Args;
 
-         if Next_Argv'Length > 0 then
-            if Next_Argv (1) = '@' then
-               if Next_Argv'Length > 1 then
-                  declare
-                     Arguments : constant Argument_List :=
-                                   Response_File.Arguments_From
-                                     (Response_File_Name        =>
-                                        Next_Argv (2 .. Next_Argv'Last),
-                                      Recursive                 => True,
-                                      Ignore_Non_Existing_Files => True);
-                  begin
-                     for J in Arguments'Range loop
-                        Scan_Bind_Arg (Arguments (J).all);
-                     end loop;
-                  end;
-               end if;
+   if Verbose_Mode then
+      Write_Str (Command_Name);
+      Put_Bind_Args;
+      Write_Eol;
+   end if;
 
-            else
-               Scan_Bind_Arg (Next_Argv);
-            end if;
-         end if;
-      end;
-
-      Next_Arg := Next_Arg + 1;
-   end loop Scan_Args;
-
    if Use_Pragma_Linker_Constructor then
       if Bind_Main_Program then
          Fail ("switch -a must be used in conjunction with -n or -Lxxx");
Index: bcheck.adb
===================================================================
--- bcheck.adb	(revision 198221)
+++ bcheck.adb	(working copy)
@@ -218,16 +218,27 @@ 
                end if;
 
                if (not Tolerate_Consistency_Errors) and Verbose_Mode then
-                  Error_Msg_File_1 := Sdep.Table (D).Sfile;
+                  Error_Msg_File_1 := Source.Table (Src).Stamp_File;
+
+                  if Source.Table (Src).Source_Found then
+                     Error_Msg_File_1 :=
+                       Osint.Full_Source_Name (Error_Msg_File_1);
+                  else
+                     Error_Msg_File_1 :=
+                       Osint.Full_Lib_File_Name (Error_Msg_File_1);
+                  end if;
+
                   Error_Msg
-                    ("{ time stamp " & String (Source.Table (Src).Stamp));
+                    ("time stamp from { " & String (Source.Table (Src).Stamp));
 
                   Error_Msg_File_1 := Sdep.Table (D).Sfile;
-                  --  Something wrong here, should be different file ???
-
                   Error_Msg
                     (" conflicts with { timestamp " &
                      String (Sdep.Table (D).Stamp));
+
+                  Error_Msg_File_1 :=
+                    Osint.Full_Lib_File_Name (ALIs.Table (A).Afile);
+                  Error_Msg (" from {");
                end if;
 
                --  Exit from the loop through Sdep entries once we find one