aboutsummaryrefslogtreecommitdiffstats
path: root/src/ghdldrv/ghdllocal.adb
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2019-03-13 19:52:46 +0100
committerTristan Gingold <tgingold@free.fr>2019-03-14 07:14:44 +0100
commitb4e20d8af1e23ab124a2f42d7eb56e86aa7850aa (patch)
tree1a7b9c67b4bb200011ef7bbe308def3384511849 /src/ghdldrv/ghdllocal.adb
parentbdf042b5b55d695f5a312bb09699503c5519858f (diff)
downloadghdl-b4e20d8af1e23ab124a2f42d7eb56e86aa7850aa.tar.gz
ghdl-b4e20d8af1e23ab124a2f42d7eb56e86aa7850aa.tar.bz2
ghdl-b4e20d8af1e23ab124a2f42d7eb56e86aa7850aa.zip
vhdl: handle names starting with '_' as an identifier.
Remove assertion. Fix #779
Diffstat (limited to 'src/ghdldrv/ghdllocal.adb')
-rw-r--r--src/ghdldrv/ghdllocal.adb51
1 files changed, 41 insertions, 10 deletions
diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb
index 5841f1b4f..aab8885c3 100644
--- a/src/ghdldrv/ghdllocal.adb
+++ b/src/ghdldrv/ghdllocal.adb
@@ -752,9 +752,15 @@ package body Ghdllocal is
end Perform_Action;
-- Command Check_Syntax.
- type Command_Check_Syntax is new Command_Lib with null record;
+ type Command_Check_Syntax is new Command_Lib with record
+ Flag_Expect_Failure : Boolean := False;
+ end record;
function Decode_Command (Cmd : Command_Check_Syntax; Name : String)
return Boolean;
+ procedure Decode_Option (Cmd : in out Command_Check_Syntax;
+ Option : String;
+ Arg : String;
+ Res : out Option_Res);
function Get_Short_Help (Cmd : Command_Check_Syntax) return String;
procedure Perform_Action (Cmd : Command_Check_Syntax;
Args : Argument_List);
@@ -774,13 +780,30 @@ package body Ghdllocal is
return "-s [OPTS] FILEs Check syntax of FILEs";
end Get_Short_Help;
- procedure Analyze_One_File (File_Name : String)
+ procedure Decode_Option (Cmd : in out Command_Check_Syntax;
+ Option : String;
+ Arg : String;
+ Res : out Option_Res)
+ is
+ pragma Assert (Option'First = 1);
+ begin
+ if Option = "--expect-failure" then
+ Cmd.Flag_Expect_Failure := True;
+ Res := Option_Ok;
+ else
+ Decode_Option (Command_Lib (Cmd), Option, Arg, Res);
+ end if;
+ end Decode_Option;
+
+ procedure Analyze_One_File (File_Name : String; Error : out Boolean)
is
Id : Name_Id;
Design_File : Iir_Design_File;
Unit : Iir;
Next_Unit : Iir;
begin
+ Error := True;
+
Id := Name_Table.Get_Identifier (File_Name);
if Flag_Verbose then
Put (File_Name);
@@ -788,7 +811,7 @@ package body Ghdllocal is
end if;
Design_File := Sem_Lib.Load_File_Name (Id);
if Design_File = Null_Iir then
- raise Errorout.Compilation_Error;
+ return;
end if;
Unit := Get_First_Design_Unit (Design_File);
@@ -810,21 +833,26 @@ package body Ghdllocal is
Unit := Next_Unit;
end loop;
- if Errorout.Nbr_Errors > 0 then
- raise Errorout.Compilation_Error;
+ if Errorout.Nbr_Errors = 0 then
+ Error := False;
end if;
end Analyze_One_File;
- procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean) is
+ procedure Analyze_Files
+ (Files : Argument_List; Save_Library : Boolean; Error : out Boolean)
+ is
+ Error_1 : Boolean;
begin
Setup_Libraries (True);
-- Parse all files.
+ Error := False;
for I in Files'Range loop
- Analyze_One_File (Files (I).all);
+ Analyze_One_File (Files (I).all, Error_1);
+ Error := Error or Error_1;
end loop;
- if Save_Library then
+ if Save_Library and then not Error then
Libraries.Save_Work_Library;
end if;
end Analyze_Files;
@@ -832,9 +860,12 @@ package body Ghdllocal is
procedure Perform_Action (Cmd : Command_Check_Syntax;
Args : Argument_List)
is
- pragma Unreferenced (Cmd);
+ Error : Boolean;
begin
- Analyze_Files (Args, False);
+ Analyze_Files (Args, False, Error);
+ if Error xor Cmd.Flag_Expect_Failure then
+ raise Errorout.Compilation_Error;
+ end if;
end Perform_Action;
-- Command --clean: remove object files.