From 51be8c1991ae4fb9678dd1cfbb62a6ae568737aa Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Wed, 19 Dec 2018 06:37:51 +0100
Subject: Sem: tolerates more parse errors.

---
 src/flags.ads            |  5 +++++
 src/ghdldrv/ghdlcomp.adb |  7 ++++++-
 src/vhdl/sem_expr.adb    | 29 +++++++++++++++++++++++------
 3 files changed, 34 insertions(+), 7 deletions(-)

(limited to 'src')

diff --git a/src/flags.ads b/src/flags.ads
index cae0fa82a..096d889c0 100644
--- a/src/flags.ads
+++ b/src/flags.ads
@@ -124,6 +124,11 @@ package Flags is
    --  If set, performs VITAL checks.
    Flag_Vital_Checks : Boolean := True;
 
+   --  Set if analysis is done even after parsing errors.  The analysis code
+   --  that handles and tolerates incorrect parse tree should check that this
+   --  flag is set.
+   Flag_Force_Analysis : Boolean := False;
+
    --  Integer and time types can be either 32 bits or 64 bits values.
    --  The default is 32 bits for Integer and 64 bits for Time.
    --  Be very careful: if you don't use the default sizes, you may have to
diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb
index e04369714..6be97c6ca 100644
--- a/src/ghdldrv/ghdlcomp.adb
+++ b/src/ghdldrv/ghdlcomp.adb
@@ -400,6 +400,9 @@ package body Ghdlcomp is
 
       Hooks.Compile_Init.all (True);
 
+      --  Analysis won't chock on incorrect parse tree.
+      Flags.Flag_Force_Analysis := Cmd.Flag_Force_Analysis;
+
       --  Parse all files.
       for I in Args'Range loop
          Id := Name_Table.Get_Identifier (Args (I).all);
@@ -428,7 +431,9 @@ package body Ghdlcomp is
 
                Next_Unit := Get_Chain (Unit);
 
-               if Errorout.Nbr_Errors = 0 then
+               if Errorout.Nbr_Errors = 0
+                 or else Cmd.Flag_Force_Analysis
+               then
                   Set_Chain (Unit, Null_Iir);
                   Libraries.Add_Design_Unit_Into_Library (Unit);
                   New_Design_File := Get_Design_File (Unit);
diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index 78d62c57c..bce547087 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -2018,15 +2018,21 @@ package body Sem_Expr is
    begin
       for I in 1 .. Len loop
          Ch := Str_Table.Char_String8 (Id, I);
-         Res := Map (Ch);
-         if Res = No_Pos then
-            El := Find_Literal (El_Type, Ch);
-            if El = Null_Iir then
-               Res := 0;
-            else
+         if Ch not in Map'Range then
+            --  Invalid character.
+            pragma Assert (Flags.Flag_Force_Analysis);
+            Res := 0;
+         else
+            Res := Map (Ch);
+            if Res = No_Pos then
+               El := Find_Literal (El_Type, Ch);
+               if El = Null_Iir then
+                  Res := 0;
+               else
                Enum_Pos := Get_Enum_Pos (El);
                Res := Nat8 (Enum_Pos);
                Map (Ch) := Res;
+               end if;
             end if;
          end if;
          Str_Table.Set_Element_String8 (Id, I, Res);
@@ -4622,6 +4628,17 @@ package body Sem_Expr is
             Error_Msg_Sem (+Expr, "%n cannot be used as an expression", +Expr);
             return Null_Iir;
 
+         when Iir_Kind_Range_Expression =>
+            --  Can only happen in case of parse error, as a range is not an
+            --  expression.
+            pragma Assert (Flags.Flag_Force_Analysis);
+            declare
+               Res : Iir;
+            begin
+               Res := Sem_Simple_Range_Expression (Expr, A_Type, True);
+               return Create_Error_Expr (Res, A_Type);
+            end;
+
          when Iir_Kind_Error =>
             -- Always ok.
             return Expr;
-- 
cgit v1.2.3