aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/ghdldrv/ghdldrv.adb6
-rw-r--r--src/ghdldrv/ghdllocal.adb51
-rw-r--r--src/ghdldrv/ghdllocal.ads3
-rw-r--r--src/vhdl/scanner.adb5
-rw-r--r--src/vhdl/sem.adb4
5 files changed, 52 insertions, 17 deletions
diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb
index 3cd7c1f74..e77bfb8f4 100644
--- a/src/ghdldrv/ghdldrv.adb
+++ b/src/ghdldrv/ghdldrv.adb
@@ -1355,6 +1355,7 @@ package body Ghdldrv is
is
pragma Unreferenced (Cmd);
Elab_Index : Integer;
+ Error : Boolean;
begin
Elab_Index := -1;
for I in Args'Range loop
@@ -1364,7 +1365,10 @@ package body Ghdldrv is
end if;
end loop;
if Elab_Index < 0 then
- Analyze_Files (Args, True);
+ Analyze_Files (Args, True, Error);
+ if Error then
+ raise Errorout.Compilation_Error;
+ end if;
else
Set_Elab_Units ("-c", Args (Elab_Index + 1 .. Args'Last));
Setup_Compiler (False);
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.
diff --git a/src/ghdldrv/ghdllocal.ads b/src/ghdldrv/ghdllocal.ads
index 3189c58cc..2a7b4ef92 100644
--- a/src/ghdldrv/ghdllocal.ads
+++ b/src/ghdldrv/ghdllocal.ads
@@ -120,7 +120,8 @@ package Ghdllocal is
-- Setup library, analyze FILES, and if SAVE_LIBRARY is set save the
-- work library only
- procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean);
+ procedure Analyze_Files
+ (Files : Argument_List; Save_Library : Boolean; Error : out Boolean);
-- Load and parse all libraries and files, starting from the work library.
-- The work library must already be loaded.
diff --git a/src/vhdl/scanner.adb b/src/vhdl/scanner.adb
index c24706ec1..c8e5a9765 100644
--- a/src/vhdl/scanner.adb
+++ b/src/vhdl/scanner.adb
@@ -2277,8 +2277,9 @@ package body Scanner is
end if;
when '_' =>
Error_Msg_Scan ("an identifier can't start with '_'");
- Pos := Pos + 1;
- goto Again;
+ Scan_Identifier (Flag_Psl);
+ -- Cannot be a reserved word.
+ return;
when 'A' .. 'Z' | 'a' .. 'z' =>
Scan_Identifier (Flag_Psl);
Identifier_To_Token;
diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index 89babd3fc..7cecd3d6b 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -3281,6 +3281,7 @@ package body Sem is
-- Analyze the library unit.
if Library_Unit /= Null_Iir then
+ -- Can be null_iir in case of parse error.
case Iir_Kinds_Library_Unit (Get_Kind (Library_Unit)) is
when Iir_Kind_Entity_Declaration =>
Sem_Entity_Declaration (Library_Unit);
@@ -3297,9 +3298,6 @@ package body Sem is
when Iir_Kind_Context_Declaration =>
Sem_Context_Declaration (Library_Unit);
end case;
- else
- pragma Assert (Flags.Flag_Force_Analysis);
- null;
end if;
Close_Declarative_Region;