vhdl: handle names starting with '_' as an identifier.

Remove assertion.
Fix #779

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;