From b268324b35da6e949c610e9cc3feb56596a8e17b Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Sun, 16 Dec 2018 07:32:20 +0100
Subject: driver: add --force-analysis debug flag.

---
 src/ghdldrv/ghdlcomp.adb | 49 +++++++++++++++++++++++++++++++++++-------------
 1 file changed, 36 insertions(+), 13 deletions(-)

diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb
index feab679cd..e04369714 100644
--- a/src/ghdldrv/ghdlcomp.adb
+++ b/src/ghdldrv/ghdlcomp.adb
@@ -38,7 +38,11 @@ package body Ghdlcomp is
    Flag_Expect_Failure : Boolean := False;
 
    --  Commands which use the mcode compiler.
-   type Command_Comp is abstract new Command_Lib with null record;
+   type Command_Comp is abstract new Command_Lib with record
+      --  If set, force semantic analysis even in case of parse error.
+      Flag_Force_Analysis : Boolean := False;
+   end record;
+
    procedure Decode_Option (Cmd : in out Command_Comp;
                             Option : String;
                             Arg : String;
@@ -58,6 +62,9 @@ package body Ghdlcomp is
       elsif Option = "--check-ast" then
          Flags.Check_Ast_Level := Flags.Check_Ast_Level + 1;
          Res := Option_Ok;
+      elsif Option = "--force-analysis" then
+         Cmd.Flag_Force_Analysis := True;
+         Res := Option_Ok;
       elsif Hooks.Decode_Option.all (Option) then
          Res := Option_Ok;
       elsif Option'Length > 18
@@ -379,7 +386,6 @@ package body Ghdlcomp is
    procedure Perform_Action (Cmd : Command_Analyze;
                              Args : Argument_List)
    is
-      pragma Unreferenced (Cmd);
       use Types;
       Id : Name_Id;
       Design_File : Iir_Design_File;
@@ -397,11 +403,17 @@ package body Ghdlcomp is
       --  Parse all files.
       for I in Args'Range loop
          Id := Name_Table.Get_Identifier (Args (I).all);
+
+         --  Parse file.
          Design_File := Load_File_Name (Id);
-         if Errorout.Nbr_Errors > 0 then
+         if Errorout.Nbr_Errors > 0
+           and then not Cmd.Flag_Force_Analysis
+         then
             raise Compilation_Error;
          end if;
 
+         New_Design_File := Null_Iir;
+
          if False then
             --  Speed up analysis: remove all previous designs.
             --  However, this is not in the LRM...
@@ -411,6 +423,7 @@ package body Ghdlcomp is
          if Design_File /= Null_Iir then
             Unit := Get_First_Design_Unit (Design_File);
             while Unit /= Null_Iir loop
+               --  Analyze unit.
                Finish_Compilation (Unit, True);
 
                Next_Unit := Get_Chain (Unit);
@@ -424,26 +437,36 @@ package body Ghdlcomp is
                Unit := Next_Unit;
             end loop;
 
-            if Errorout.Nbr_Errors > 0 then
+            if Errorout.Nbr_Errors > 0
+              and then not Cmd.Flag_Force_Analysis
+            then
                raise Compilation_Error;
             end if;
 
             Free_Iir (Design_File);
 
             --  Do late analysis checks.
-            Unit := Get_First_Design_Unit (New_Design_File);
-            while Unit /= Null_Iir loop
-               Sem.Sem_Analysis_Checks_List
-                 (Unit, Is_Warning_Enabled (Warnid_Delayed_Checks));
-               Unit := Get_Chain (Unit);
-            end loop;
-
-            if Errorout.Nbr_Errors > 0 then
-               raise Compilation_Error;
+            if New_Design_File /= Null_Iir then
+               Unit := Get_First_Design_Unit (New_Design_File);
+               while Unit /= Null_Iir loop
+                  Sem.Sem_Analysis_Checks_List
+                    (Unit, Is_Warning_Enabled (Warnid_Delayed_Checks));
+                  Unit := Get_Chain (Unit);
+               end loop;
+
+               if Errorout.Nbr_Errors > 0
+                 and then not Cmd.Flag_Force_Analysis
+               then
+                  raise Compilation_Error;
+               end if;
             end if;
          end if;
       end loop;
 
+      if Errorout.Nbr_Errors > 0 then
+         raise Compilation_Error;
+      end if;
+
       if Flag_Expect_Failure then
          raise Compilation_Error;
       end if;
-- 
cgit v1.2.3