From 92d0ab4e50abbf6048d6e70e2e34a93bae2b5f9e Mon Sep 17 00:00:00 2001
From: gingold
Date: Tue, 11 Dec 2012 02:32:56 +0000
Subject: Improve error message when a filename is used instead of a unit name

---
 errorout.adb                    | 12 ++++----
 errorout.ads                    |  4 +++
 translate/ghdldrv/ghdllocal.adb | 64 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 75 insertions(+), 5 deletions(-)

diff --git a/errorout.adb b/errorout.adb
index 3332de2..9b2e4a6 100644
--- a/errorout.adb
+++ b/errorout.adb
@@ -86,14 +86,16 @@ package body Errorout is
       raise Internal_Error;
    end Error_Kind;
 
-   -- Disp an error, prepended with program name.
-   -- This is used for errors before initialisation, such as bad option or
-   -- bad filename.
-   procedure Error_Msg_Option (Msg: String) is
+   procedure Error_Msg_Option_NR (Msg: String) is
    begin
       Put (Ada.Command_Line.Command_Name);
-      Put (":*command-line*: ");
+      Put (": ");
       Put_Line (Msg);
+   end Error_Msg_Option_NR;
+
+   procedure Error_Msg_Option (Msg: String) is
+   begin
+      Error_Msg_Option_NR (Msg);
       raise Option_Error;
    end Error_Msg_Option;
 
diff --git a/errorout.ads b/errorout.ads
index 2d8365c..2a8e489 100644
--- a/errorout.ads
+++ b/errorout.ads
@@ -49,6 +49,10 @@ package Errorout is
    -- This is used for errors before initialisation, such as bad option or
    -- bad filename.
    procedure Error_Msg_Option (Msg: String);
+   pragma No_Return (Error_Msg_Option);
+
+   --  Same as Error_Msg_Option but do not raise Option_Error.
+   procedure Error_Msg_Option_NR (Msg: String);
 
    -- Disp an error location (using AN_IIR location) using the standard
    -- format `file:line:col: '.
diff --git a/translate/ghdldrv/ghdllocal.adb b/translate/ghdldrv/ghdllocal.adb
index 3b3ff2b..31a099d 100644
--- a/translate/ghdldrv/ghdllocal.adb
+++ b/translate/ghdldrv/ghdllocal.adb
@@ -1125,9 +1125,73 @@ package body Ghdllocal is
    function Convert_Name (Name : String_Access) return String_Access
    is
       use Name_Table;
+
+      function Is_Bad_Unit_Name return Boolean is
+      begin
+         if Name_Length = 0 then
+            return True;
+         end if;
+         --  Don't try to handle extended identifier.
+         if Name_Buffer (1) = '\' then
+            return False;
+         end if;
+         --  Look for suspicious characters.
+         --  Do not try to be exhaustive as the correct check will be done
+         --  by convert_identifier.
+         for I in 1 .. Name_Length loop
+            case Name_Buffer (I) is
+               when '.' | '/' | '\' =>
+                  return True;
+               when others =>
+                  null;
+            end case;
+         end loop;
+         return False;
+      end Is_Bad_Unit_Name;
+
+      function Is_A_File_Name return Boolean is
+      begin
+         --  Check .vhd
+         if Name_Length > 4
+           and then Name_Buffer (Name_Length - 3 .. Name_Length) = ".vhd"
+         then
+            return True;
+         end if;
+         --  Check .vhdl
+         if Name_Length > 5
+           and then Name_Buffer (Name_Length - 4 .. Name_Length) = ".vhdl"
+         then
+            return True;
+         end if;
+         --  Check ../
+         if Name_Length > 3
+           and then Name_Buffer (1 .. 3) = "../"
+         then
+            return True;
+         end if;
+         --  Check ..\
+         if Name_Length > 3
+           and then Name_Buffer (1 .. 3) = "..\"
+         then
+            return True;
+         end if;
+         --  Should try to find the file ?
+         return False;
+      end Is_A_File_Name;
    begin
       Name_Length := Name'Length;
       Name_Buffer (1 .. Name_Length) := Name.all;
+
+      --  Try to identifier bad names (such as file names), so that
+      --  friendly message can be displayed.
+      if Is_Bad_Unit_Name then
+         Errorout.Error_Msg_Option_NR ("bad unit name '" & Name.all & "'");
+         if Is_A_File_Name then
+            Errorout.Error_Msg_Option_NR
+              ("(a unit name is required instead of a filename)");
+         end if;
+         raise Option_Error;
+      end if;
       Scan.Convert_Identifier;
       return new String'(Name_Buffer (1 .. Name_Length));
    end Convert_Name;
-- 
cgit