synth-vhdl_stmts: check subtype compatibility for scalar signal assoc.

Fix #2032

3 files changed, 93 insertions, 1 deletions

diff --git a/src/synth/elab-vhdl_objtypes.adb b/src/synth/elab-vhdl_objtypes.adb
index 7532e3ae8..8e1d97324 100644
--- a/src/synth/elab-vhdl_objtypes.adb
+++ b/src/synth/elab-vhdl_objtypes.adb
@@ -117,6 +117,37 @@ package body Elab.Vhdl_Objtypes is
       end case;
    end Are_Types_Equal;
 
+   function Is_Null_Range (Rng : Discrete_Range_Type) return Boolean is
+   begin
+      case Rng.Dir is
+         when Dir_To =>
+            return Rng.Left > Rng.Right;
+         when Dir_Downto =>
+            return Rng.Left < Rng.Right;
+      end case;
+   end Is_Null_Range;
+
+   function Is_Scalar_Subtype_Compatible (L, R : Type_Acc) return Boolean is
+   begin
+      pragma Assert (L.Kind = R.Kind);
+      case L.Kind is
+         when Type_Bit
+           | Type_Logic =>
+            --  We have no bounds for that...
+            return True;
+         when Type_Discrete =>
+            if Is_Null_Range (L.Drange) then
+               return True;
+            end if;
+            return In_Range (R.Drange, L.Drange.Left)
+              and then In_Range (R.Drange, L.Drange.Right);
+         when Type_Float =>
+            return L.Frange = R.Frange;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Is_Scalar_Subtype_Compatible;
+
    function Discrete_Range_Width (Rng : Discrete_Range_Type) return Uns32
    is
       Lo, Hi : Int64;
diff --git a/src/synth/elab-vhdl_objtypes.ads b/src/synth/elab-vhdl_objtypes.ads
index 46f088dfd..59f18b534 100644
--- a/src/synth/elab-vhdl_objtypes.ads
+++ b/src/synth/elab-vhdl_objtypes.ads
@@ -240,6 +240,10 @@ package Elab.Vhdl_Objtypes is
 
    function Are_Types_Equal (L, R : Type_Acc) return Boolean;
 
+   --  Return True iff L is within R.
+   --  See LRM08 5.2.1 (Scalar types) for definition of compatible.
+   function Is_Scalar_Subtype_Compatible (L, R : Type_Acc) return Boolean;
+
    --  Return the length of a vector type.
    function Vec_Length (Typ : Type_Acc) return Iir_Index32;
 
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb
index b2655a2d6..f6624b55e 100644
--- a/src/synth/synth-vhdl_stmts.adb
+++ b/src/synth/synth-vhdl_stmts.adb
@@ -1832,7 +1832,64 @@ package body Synth.Vhdl_Stmts is
          end if;
 
          --  FIXME: conversion only for constants, reshape for all.
-         Val := Synth_Subtype_Conversion (Ctxt, Val, Inter_Type, True, Assoc);
+         case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is
+            when Iir_Kind_Interface_Constant_Declaration
+              | Iir_Kind_Interface_Variable_Declaration =>
+               --  Always passed by value
+               Val := Synth_Subtype_Conversion
+                 (Ctxt, Val, Inter_Type, True, Assoc);
+            when Iir_Kind_Interface_Signal_Declaration =>
+               --  LRM08 4.2.2.3 Signal parameters
+               --  If an actual signal is associated with a signal parameter
+               --  of mode IN or INOUT, and if the type of the formal is a
+               --  scalar type, then it is an error if the subtype of the
+               --  actual is not compatible with the subtype of the formal.
+               --  Similarly, if an actual signal is associated with a signal
+               --  parameter of mode OUT or INOUT, and if the type of the
+               --  actual is a scalar type, then it is an error if the subtype
+               --  of the formal is not compatible with the subtype of the
+               --  actual.
+               if Get_Kind (Get_Type (Inter)) in
+                 Iir_Kinds_Scalar_Type_And_Subtype_Definition
+               then
+                  if Get_Mode (Inter) in Iir_In_Modes then
+                     if not Is_Scalar_Subtype_Compatible (Val.Typ, Inter_Type)
+                     then
+                        Error_Msg_Synth
+                          (+Actual,
+                           "scalar subtype of actual is not compatible with "
+                             & "signal formal interface");
+                        Val := No_Valtyp;
+                     end if;
+                  end if;
+                  if Get_Mode (Inter) in Iir_Out_Modes then
+                     if not Is_Scalar_Subtype_Compatible (Inter_Type, Val.Typ)
+                     then
+                        Error_Msg_Synth
+                          (+Actual,
+                           "signal formal interface scalar subtype is not "
+                             & "compatible with of actual subtype");
+                        Val := No_Valtyp;
+                     end if;
+                  end if;
+               else
+                  --  Check matching.
+                  --  This is equivalent to subtype conversion for non-scalar
+                  --  types.
+                  Val := Synth_Subtype_Conversion
+                    (Ctxt, Val, Inter_Type, True, Assoc);
+               end if;
+            when Iir_Kind_Interface_File_Declaration =>
+               null;
+            when Iir_Kind_Interface_Quantity_Declaration =>
+               raise Internal_Error;
+         end case;
+
+         if Val = No_Valtyp then
+            --  Error after conversion.
+            Set_Error (Subprg_Inst);
+            return;
+         end if;
 
          if Get_Instance_Const (Subprg_Inst) and then not Is_Static (Val.Val)
          then