summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorgingold2012-12-11 02:32:56 +0000
committergingold2012-12-11 02:32:56 +0000
commit92d0ab4e50abbf6048d6e70e2e34a93bae2b5f9e (patch)
tree0bfb9c55f8f39ed9d557b6e2bc9f259f7d1d65a0
parent977737c9166d3c69894f30af940029a8364c74fc (diff)
downloadghdl-92d0ab4e50abbf6048d6e70e2e34a93bae2b5f9e.tar.gz
ghdl-92d0ab4e50abbf6048d6e70e2e34a93bae2b5f9e.tar.bz2
ghdl-92d0ab4e50abbf6048d6e70e2e34a93bae2b5f9e.zip
Improve error message when a filename is used instead of a unit name
-rw-r--r--errorout.adb12
-rw-r--r--errorout.ads4
-rw-r--r--translate/ghdldrv/ghdllocal.adb64
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;