Handle protected function as association conversion function.

Fix #400

4 files changed, 71 insertions, 18 deletions

diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb
index 48856557c..2136466b3 100644
--- a/src/vhdl/sem_assocs.adb
+++ b/src/vhdl/sem_assocs.adb
@@ -1564,6 +1564,7 @@ package body Sem_Assocs is
             Assoc := Get_Parameter_Association_Chain (Func);
             Free_Iir (Assoc);
             Set_Parameter_Association_Chain (Func, Null_Iir);
+            Name_To_Method_Object (Func, Conv);
             return Func;
          when Iir_Kind_Type_Conversion =>
             return Func;
@@ -1600,6 +1601,7 @@ package body Sem_Assocs is
             Set_Type (Res, Get_Return_Type (Func));
             Set_Expr_Staticness (Res, None);
             Mark_Subprogram_Used (Func);
+            Name_To_Method_Object (Res, Conv);
          when Iir_Kind_Subtype_Declaration
            | Iir_Kind_Type_Declaration =>
             Res := Create_Iir (Iir_Kind_Type_Conversion);
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 0baf6c71d..ddf592cf6 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -1872,7 +1872,8 @@ package body Sem_Names is
 
    --  LRM93 §6.3
    --  Selected Names.
-   procedure Sem_Selected_Name (Name: Iir; Keep_Alias : Boolean := False)
+   procedure Sem_Selected_Name
+     (Name: Iir; Keep_Alias : Boolean := False; Soft : Boolean := False)
    is
       Suffix : constant Name_Id := Get_Identifier (Name);
       Prefix_Name : constant Iir := Get_Prefix (Name);
@@ -2023,7 +2024,11 @@ package body Sem_Names is
       end Error_Unit_Not_Found;
    begin
       --  Analyze prefix.
-      Sem_Name (Prefix_Name);
+      if Soft then
+         Sem_Name_Soft (Prefix_Name);
+      else
+         Sem_Name (Prefix_Name);
+      end if;
       Prefix := Get_Named_Entity (Prefix_Name);
       if Prefix = Error_Mark then
          Set_Named_Entity (Name, Prefix);
@@ -2080,7 +2085,7 @@ package body Sem_Names is
                   end loop;
                end if;
             end;
-            if Res = Null_Iir then
+            if Res = Null_Iir and then not Soft then
                Error_Msg_Sem
                  (+Name, "no suffix %i for overloaded selected name", +Suffix);
             end if;
@@ -2094,11 +2099,11 @@ package body Sem_Names is
             --  particularly for an architecture body.
             --  GHDL: FIXME: error message more explicit
             Res := Libraries.Load_Primary_Unit (Prefix, Suffix, Name);
-            if Res = Null_Iir then
-               Error_Unit_Not_Found (Prefix);
-            else
+            if Res /= Null_Iir then
                Sem.Add_Dependence (Res);
                Res := Get_Library_Unit (Res);
+            elsif not Soft then
+               Error_Unit_Not_Found (Prefix);
             end if;
          when Iir_Kind_Process_Statement
            | Iir_Kind_Procedure_Declaration
@@ -2133,8 +2138,10 @@ package body Sem_Names is
             Res := Find_Declarations_In_List (Prefix, Name, Keep_Alias);
 
             if Res = Null_Iir then
-               Error_Msg_Sem
-                 (+Name, "no declaration for %i in %n", (+Suffix, +Prefix));
+               if not Soft then
+                  Error_Msg_Sem
+                    (+Name, "no declaration for %i in %n", (+Suffix, +Prefix));
+               end if;
             else
                --  LRM93 §6.3
                --  This form of expanded name is only allowed within the
@@ -2144,6 +2151,7 @@ package body Sem_Names is
                                Iir_Kind_Package_Declaration,
                                Iir_Kind_Package_Instantiation_Declaration)
                  and then not Get_Is_Within_Flag (Prefix)
+                 and then not Soft
                then
                   Error_Msg_Sem
                     (+Prefix_Loc,
@@ -2156,7 +2164,7 @@ package body Sem_Names is
             if Res = Null_Iir then
                Sem_As_Selected_Element (Prefix);
             end if;
-            if Res = Null_Iir then
+            if Res = Null_Iir and then not Soft then
                Error_Selected_Element (Get_Return_Type (Prefix));
             end if;
          when Iir_Kinds_Object_Declaration
@@ -2170,12 +2178,12 @@ package body Sem_Names is
               = Iir_Kind_Protected_Type_Declaration
             then
                Sem_As_Protected_Item (Prefix);
-               if Res = Null_Iir then
+               if Res = Null_Iir and then not Soft then
                   Error_Protected_Item (Prefix);
                end if;
             else
                Sem_As_Selected_Element (Prefix);
-               if Res = Null_Iir then
+               if Res = Null_Iir and then not Soft then
                   Error_Selected_Element (Get_Type (Prefix));
                end if;
             end if;
@@ -2185,8 +2193,10 @@ package body Sem_Names is
            | Iir_Kind_Component_Instantiation_Statement
            | Iir_Kind_Slice_Name
            | Iir_Kind_Procedure_Call_Statement =>
-            Error_Msg_Sem
-              (+Prefix_Loc, "%n cannot be selected by name", +Prefix);
+            if not Soft then
+               Error_Msg_Sem
+                 (+Prefix_Loc, "%n cannot be selected by name", +Prefix);
+            end if;
 
          when others =>
             Error_Kind ("sem_selected_name(2)", Prefix);
@@ -3732,6 +3742,8 @@ package body Sem_Names is
            | Iir_Kind_Operator_Symbol =>
             --  String_Literal may be a operator_symbol.
             Sem_Simple_Name (Name, False, Soft => True);
+         when Iir_Kind_Selected_Name =>
+            Sem_Selected_Name (Name, Keep_Alias => False, Soft => True);
          when others =>
             Error_Kind ("sem_name_soft", Name);
       end case;
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index b496be745..ba95730a1 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -2634,6 +2634,8 @@ package body Trans.Chap4 is
       Res         : Mnode;
       Imp         : Iir;
       Func        : Iir;
+      Obj         : Iir;  --  Method object for function conversion
+      Obj_Type    : Iir;  --  Valid only if OBJ is valid
    begin
       case Mode is
          when Conv_Mode_In =>
@@ -2661,6 +2663,15 @@ package body Trans.Chap4 is
       Out_Info := Get_Info (Out_Type);
       In_Info := Get_Info (In_Type);
 
+      if Get_Kind (Imp) = Iir_Kind_Function_Call then
+         Obj := Get_Method_Object (Imp);
+         if Is_Valid (Obj) then
+            Obj_Type := Get_Type (Obj);
+         end if;
+      else
+         Obj := Null_Iir;
+      end if;
+
       --  Start record containing data for the conversion function.
       Start_Record_Type (El_List);
 
@@ -2690,6 +2701,14 @@ package body Trans.Chap4 is
          Conv_Info.Instantiated_Field := O_Fnode_Null;
       end if;
 
+      if Obj /= Null_Iir then
+         New_Record_Field
+           (El_List, Conv_Info.Method_Object, Get_Identifier ("obj"),
+            Get_Info (Obj_Type).Ortho_Ptr_Type (Mode_Value));
+      else
+         Conv_Info.Method_Object := O_Fnode_Null;
+      end if;
+
       --  Add inputs, which is a pointer to the signal.
       New_Record_Field
         (El_List, Conv_Info.In_Sig_Field, Get_Identifier ("sig_in"),
@@ -2816,8 +2835,17 @@ package body Trans.Chap4 is
                New_Association (Constr, M2E (Res));
             end if;
 
-            Subprgs.Add_Subprg_Instance_Assoc
-              (Constr, Subprg_Info.Subprg_Instance);
+            if Obj /= Null_Iir then
+               --  Protected object.
+               New_Association
+                 (Constr,
+                  New_Value (New_Selected_Acc_Value
+                               (New_Obj (Var_Data),
+                                Conv_Info.Method_Object)));
+            else
+               Subprgs.Add_Subprg_Instance_Assoc
+                 (Constr, Subprg_Info.Subprg_Instance);
+            end if;
 
             New_Association (Constr, R);
 
@@ -2923,6 +2951,7 @@ package body Trans.Chap4 is
 
    procedure Elab_Conversion (Sig_In     : Iir;
                               Sig_Out    : Iir;
+                              Conv       : Iir;
                               Reg_Subprg : O_Dnode;
                               Info       : Assoc_Conv_Info;
                               Dest_Sig   : out Mnode)
@@ -2969,11 +2998,19 @@ package body Trans.Chap4 is
             end if;
             New_Assign_Stmt
               (New_Selected_Acc_Value (New_Obj (Var_Data),
-               Info.Instantiated_Field),
+                                       Info.Instantiated_Field),
                Inst_Addr);
          end;
       end if;
 
+      if Info.Method_Object /= O_Fnode_Null then
+         New_Assign_Stmt
+           (New_Selected_Acc_Value (New_Obj (Var_Data),
+                                    Info.Method_Object),
+            M2E (Chap6.Translate_Name
+                   (Get_Method_Object (Conv), Mode_Value)));
+      end if;
+
       --  Set input.
       Chap6.Translate_Signal_Name (Sig_In, Src_Sig, Src_Val);
       Src_Sig := Stabilize (Src_Sig, True);
@@ -3048,7 +3085,7 @@ package body Trans.Chap4 is
       Assoc_Info : constant Assoc_Info_Acc := Get_Info (Assoc);
    begin
       Elab_Conversion
-        (Get_Actual (Assoc), Formal,
+        (Get_Actual (Assoc), Formal, Get_In_Conversion (Assoc),
          Ghdl_Signal_In_Conversion, Assoc_Info.Assoc_In, Ndest);
    end Elab_In_Conversion;
 
@@ -3060,7 +3097,7 @@ package body Trans.Chap4 is
       Assoc_Info : constant Assoc_Info_Acc := Get_Info (Assoc);
    begin
       Elab_Conversion
-        (Formal, Get_Actual (Assoc),
+        (Formal, Get_Actual (Assoc), Get_Out_Conversion (Assoc),
          Ghdl_Signal_Out_Conversion, Assoc_Info.Assoc_Out, Ndest);
    end Elab_Out_Conversion;
 
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index 1d57e7ed0..f18795e61 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -1147,6 +1147,8 @@ package Trans is
       Instantiated_Entity : Iir;
       --   and its address.
       Instantiated_Field  : O_Fnode;
+      --  The object if the subprogram is a method
+      Method_Object       : O_Fnode;
       In_Sig_Field        : O_Fnode;
       In_Val_Field        : O_Fnode;
       Out_Sig_Field       : O_Fnode;