diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/vhdl/iirs_utils.adb | 6 | ||||
| -rw-r--r-- | src/vhdl/sem_inst.adb | 34 |
2 files changed, 26 insertions, 14 deletions
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index ac6a2dd06..7a8dd84bf 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -892,9 +892,13 @@ package body Iirs_Utils is function Is_Second_Subprogram_Specification (Spec : Iir) return Boolean is - Bod : constant Iir := Get_Subprogram_Body (Spec); + Bod : constant Iir := Get_Chain (Spec); begin + -- FIXME: don't directly use Subprogram_Body as it is not yet correctly + -- set during instantiation. return Bod /= Null_Iir + and then Kind_In (Bod, Iir_Kind_Function_Body, + Iir_Kind_Procedure_Body) and then Get_Subprogram_Specification (Bod) /= Spec; end Is_Second_Subprogram_Specification; diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb index cb52af129..597010b62 100644 --- a/src/vhdl/sem_inst.adb +++ b/src/vhdl/sem_inst.adb @@ -384,25 +384,33 @@ package body Sem_Inst is Set_Index_Subtype_List (Res, List); end; + when Field_Subprogram_Body => + -- This is a forward reference. Not yet solved. + Set_Subprogram_Body (Res, Null_Iir); + + when Field_Subprogram_Specification => + -- Resolve it. + Instantiate_Iir_Field (Res, N, F); + + -- Set body. + pragma Assert (Kind_In (Res, Iir_Kind_Procedure_Body, + Iir_Kind_Function_Body)); + declare + Spec : constant Iir := Get_Subprogram_Specification (Res); + begin + pragma Assert (Get_Subprogram_Body (Spec) = Null_Iir); + Set_Subprogram_Body (Spec, Res); + end; + when others => -- Common case. Instantiate_Iir_Field (Res, N, F); end case; end loop; - case Kind is - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - -- Subprogram body is a forward declaration. - -- Clear Subprogram_Body so that the node is seen as a - -- declaration and not a specification of a body. - Set_Subprogram_Body (Res, Null_Iir); - when others => - -- TODO: other forward references: - -- incomplete constant - -- attribute_value - null; - end case; + -- TODO: other forward references: + -- incomplete constant + -- attribute_value return Res; end; |