synth: improve propagation of errors.

5 files changed, 58 insertions, 21 deletions

diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index 05e412f13..d61a67241 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -878,6 +878,8 @@ package body Synth.Decls is
       while Is_Valid (Decl) loop
          Synth_Declaration (Syn_Inst, Decl, Is_Subprg, Last_Type);
 
+         exit when Is_Error (Syn_Inst);
+
          Decl := Get_Chain (Decl);
       end loop;
    end Synth_Declarations;
@@ -892,6 +894,11 @@ package body Synth.Decls is
       Def_Val : Net;
    begin
       Val := Get_Value (Syn_Inst, Decl);
+      if Val = null then
+         pragma Assert (Is_Error (Syn_Inst));
+         return;
+      end if;
+
       Gate_Net := Get_Wire_Gate (Val.W);
       Gate := Get_Net_Parent (Gate_Net);
       case Get_Id (Gate) is
diff --git a/src/synth/synth-files_operations.adb b/src/synth/synth-files_operations.adb
index 29c70d98d..5c8b6b153 100644
--- a/src/synth/synth-files_operations.adb
+++ b/src/synth/synth-files_operations.adb
@@ -64,16 +64,19 @@ package body Synth.Files_Operations is
    procedure Convert_File_Name (Val : Value_Acc;
                                 Res : out C_File_Name;
                                 Len : out Natural;
-                                Status : out Op_Status) is
+                                Status : out Op_Status)
+   is
+      Name : constant Value_Acc := Strip_Alias_Const (Val);
+      pragma Unreferenced (Val);
    begin
-      Len := Natural (Val.Arr.Len);
+      Len := Natural (Name.Arr.Len);
 
       if Len >= Res'Length - 1 then
          Status := Op_Filename_Error;
          return;
       end if;
 
-      Convert_String (Val, Res (1 .. Len));
+      Convert_String (Name, Res (1 .. Len));
       Res (Len + 1) := Grt.Types.NUL;
 
       Status := Op_Ok;
@@ -149,7 +152,7 @@ package body Synth.Files_Operations is
          if Status = Op_Name_Error then
             Error_Msg_Synth
               (+Decl, "cannot open file: " & C_Name (1 .. C_Name_Len));
-            raise File_Execution_Error;
+            Set_Error (Syn_Inst);
          else
             File_Error (Decl, Status);
          end if;
diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb
index 18c23b8bb..797033bb8 100644
--- a/src/synth/synth-insts.adb
+++ b/src/synth/synth-insts.adb
@@ -1426,15 +1426,25 @@ package body Synth.Insts is
       Apply_Block_Configuration (Inst.Config, Arch);
 
       Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Entity));
-      Synth_Concurrent_Statements
-        (Syn_Inst, Get_Concurrent_Statement_Chain (Entity));
+      if not Is_Error (Syn_Inst) then
+         Synth_Concurrent_Statements
+           (Syn_Inst, Get_Concurrent_Statement_Chain (Entity));
+      end if;
 
-      Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Arch));
-      Synth_Concurrent_Statements
-        (Syn_Inst, Get_Concurrent_Statement_Chain (Arch));
+      if not Is_Error (Syn_Inst) then
+         Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Arch));
+      end if;
+      if not Is_Error (Syn_Inst) then
+         Synth_Concurrent_Statements
+           (Syn_Inst, Get_Concurrent_Statement_Chain (Arch));
+      end if;
 
-      Synth_Verification_Units (Syn_Inst, Entity);
-      Synth_Verification_Units (Syn_Inst, Arch);
+      if not Is_Error (Syn_Inst) then
+         Synth_Verification_Units (Syn_Inst, Entity);
+      end if;
+      if not Is_Error (Syn_Inst) then
+         Synth_Verification_Units (Syn_Inst, Arch);
+      end if;
 
       Finalize_Assignments (Get_Build (Syn_Inst));
 
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index 20d0d3420..f7062ce68 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -1801,19 +1801,26 @@ package body Synth.Stmts is
 
       Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod), True);
 
-      Synth_Sequential_Statements (C, Get_Sequential_Statement_Chain (Bod));
+      if not Is_Error (C.Inst) then
+         Synth_Sequential_Statements (C, Get_Sequential_Statement_Chain (Bod));
+      end if;
 
-      if Is_Func then
-         if C.Nbr_Ret = 0 then
-            raise Internal_Error;
-         elsif C.Nbr_Ret = 1 and then Is_Static (C.Ret_Value) then
-            Res := C.Ret_Value;
+      if Is_Error (C.Inst) then
+         Res := null;
+      else
+         if Is_Func then
+            if C.Nbr_Ret = 0 then
+               --  Function returned without a return statement.
+               raise Internal_Error;
+            else
+               pragma Assert (C.Nbr_Ret = 1);
+               pragma Assert (Is_Static (C.Ret_Value));
+               Res := C.Ret_Value;
+            end if;
          else
-            raise Internal_Error;
+            Res := null;
+            Synth_Subprogram_Back_Association (C.Inst, Syn_Inst, Init, Infos);
          end if;
-      else
-         Res := null;
-         Synth_Subprogram_Back_Association (C.Inst, Syn_Inst, Init, Infos);
       end if;
 
       Decls.Finalize_Declarations (C.Inst, Get_Declaration_Chain (Bod), True);
@@ -1864,6 +1871,11 @@ package body Synth.Stmts is
          end if;
       end if;
 
+      --  Propagate error.
+      if Is_Error (Sub_Inst) then
+         Set_Error (Syn_Inst);
+      end if;
+
       Free_Instance (Sub_Inst);
       Areapools.Release (Area_Mark, Instance_Pool.all);
 
diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads
index 416f2729d..7c4ec8b7c 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/synth-values.ads
@@ -335,6 +335,11 @@ package Synth.Values is
    procedure Strip_Const (Val : in out Value_Acc);
    function Strip_Const (Val : Value_Acc) return Value_Acc;
 
+   --  If VAL is a const or an alias, replace it by its value.
+   --  Used to extract the real data of a static value.  Note that the type
+   --  is not correct anymore.
+   function Strip_Alias_Const (V : Value_Acc) return Value_Acc;
+
    function Unshare (Src : Value_Acc; Pool : Areapool_Acc)
                     return Value_Acc;