diff options
| -rw-r--r-- | src/grt/grt-files.adb | 14 | ||||
| -rw-r--r-- | src/vhdl/iirs_utils.adb | 12 | ||||
| -rw-r--r-- | src/vhdl/iirs_utils.ads | 5 | ||||
| -rw-r--r-- | src/vhdl/sem_expr.adb | 8 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap8.adb | 4 |
5 files changed, 32 insertions, 11 deletions
diff --git a/src/grt/grt-files.adb b/src/grt/grt-files.adb index 1f037a76e..a47381289 100644 --- a/src/grt/grt-files.adb +++ b/src/grt/grt-files.adb @@ -245,15 +245,18 @@ package body Grt.Files is (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr) is Res : Ghdl_I32; + Bt : Backtrace_Addrs; begin Check_File_Mode (File, True); Res := File_Open (File, Mode, Str); if Res /= Open_Ok then - Error_C ("open: cannot open text file "); + Save_Backtrace (Bt, 1); + Error_C ("cannot open text file """); Error_C_Std (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1)); - Error_E; + Error_C (""""); + Error_E_Call_Stack (Bt); end if; end Ghdl_Text_File_Open; @@ -261,15 +264,18 @@ package body Grt.Files is (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr) is Res : Ghdl_I32; + Bt : Backtrace_Addrs; begin Check_File_Mode (File, False); Res := File_Open (File, Mode, Str); if Res /= Open_Ok then - Error_C ("open: cannot open file "); + Save_Backtrace (Bt, 1); + Error_C ("cannot open file """); Error_C_Std (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1)); - Error_E; + Error_C (""""); + Error_E_Call_Stack (Bt); end if; end Ghdl_File_Open; diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index e5e9a5acf..14dc0a2c4 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -1187,6 +1187,18 @@ package body Iirs_Utils is end case; end Get_Method_Type; + function Get_Actual_Or_Default (Assoc : Iir) return Iir is + begin + case Get_Kind (Assoc) is + when Iir_Kind_Association_Element_By_Expression => + return Get_Actual (Assoc); + when Iir_Kind_Association_Element_Open => + return Get_Default_Value (Get_Formal (Assoc)); + when others => + Error_Kind ("get_actual_or_default", Assoc); + end case; + end Get_Actual_Or_Default; + function Create_Error (Orig : Iir) return Iir is Res : Iir; diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads index de63f5af4..c8ab9174d 100644 --- a/src/vhdl/iirs_utils.ads +++ b/src/vhdl/iirs_utils.ads @@ -253,6 +253,11 @@ package Iirs_Utils is -- Return the protected type for method SPEC. function Get_Method_Type (Spec : Iir) return Iir; + -- For Association_Element_By_Expression: return the actual. + -- For Association_Element_Open: return the default value of the + -- interface. + function Get_Actual_Or_Default (Assoc : Iir) return Iir; + -- Create an error node for node ORIG. function Create_Error (Orig : Iir) return Iir; diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb index 1a07446b4..f36132407 100644 --- a/src/vhdl/sem_expr.adb +++ b/src/vhdl/sem_expr.adb @@ -1611,11 +1611,9 @@ package body Sem_Expr is if Ref_Type = Universal_Integer_Type_Definition or Ref_Type = Universal_Real_Type_Definition then - if Res = Null_Iir then - Res := El; - else - return Null_Iir; - end if; + -- There could be only one such subprogram. + pragma Assert (Res = Null_Iir); + Res := El; end if; end if; end loop; diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 54a3ae39c..c2dbf4ed7 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -2023,7 +2023,7 @@ package body Trans.Chap8 is N_Param := Get_Chain (Param_Chain); Name_Param := Get_Actual (N_Param); N_Param := Get_Chain (N_Param); - Kind_Param := Get_Actual (N_Param); + Kind_Param := Get_Actual_Or_Default (N_Param); if Get_Text_File_Flag (Get_Type (File_Param)) then Start_Association (Constr, Ghdl_Text_File_Open); else @@ -2060,7 +2060,7 @@ package body Trans.Chap8 is N_Param := Get_Chain (N_Param); Name_Param := Get_Actual (N_Param); N_Param := Get_Chain (N_Param); - Kind_Param := Get_Actual (N_Param); + Kind_Param := Get_Actual_Or_Default (N_Param); if Get_Text_File_Flag (Get_Type (File_Param)) then Start_Association (Constr, Ghdl_Text_File_Open_Status); else |