diff options
Diffstat (limited to 'src/vhdl/sem_expr.adb')
| -rw-r--r-- | src/vhdl/sem_expr.adb | 60 |
1 files changed, 21 insertions, 39 deletions
diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb index 415662a9f..050c17680 100644 --- a/src/vhdl/sem_expr.adb +++ b/src/vhdl/sem_expr.adb @@ -33,28 +33,6 @@ with Xrefs; use Xrefs; package body Sem_Expr is - procedure Not_Match (Expr: Iir; A_Type: Iir) - is - pragma Inline (Not_Match); - begin - Error_Not_Match (Expr, A_Type, Expr); - end Not_Match; - --- procedure Not_Match (Expr: Iir; Type1: Iir; Type2: Iir) is --- begin --- Error_Msg_Sem --- ("can't match '" & Disp_Node (Expr) & "' with type '" --- & Disp_Node (Type1) & "' or type '" & Disp_Node (Type2) & "'", --- Expr); --- end Not_Match; - --- procedure Overloaded (Expr: Iir) is --- begin --- Error_Msg_Sem --- ("cant resolve overloaded identifier '" & Get_String (Expr) & "'", --- Expr); --- end Overloaded; - -- Replace type of TARGET by A_TYPE. -- If TARGET has already a type, it must be an overload list, and in this -- case, this list is freed, or it must be A_TYPE. @@ -760,7 +738,7 @@ package body Sem_Expr is if A_Type /= Null_Iir and then Get_Base_Type (Res_Type) /= Get_Base_Type (A_Type) then - Not_Match (Expr, A_Type); + Error_Not_Match (Expr, A_Type); return Null_Iir; end if; @@ -1482,7 +1460,7 @@ package body Sem_Expr is end if; end if; if Res = Null_Iir then - Not_Match (Expr, A_Type); + Error_Not_Match (Expr, A_Type); return Null_Iir; end if; @@ -2631,7 +2609,7 @@ package body Sem_Expr is Name1 : Iir; begin if Are_Types_Compatible (Range_Type, Sub_Type) = Not_Compatible then - Not_Match (Name, Sub_Type); + Error_Not_Match (Name, Sub_Type); return False; end if; @@ -3741,7 +3719,7 @@ package body Sem_Expr is Error_Msg_Sem ("expected type is not an access type", Expr); end if; else - Not_Match (Expr, A_Type); + Error_Not_Match (Expr, A_Type); end if; return Null_Iir; end if; @@ -3762,7 +3740,7 @@ package body Sem_Expr is if A_Type /= Null_Iir and then Are_Types_Compatible (A_Type, N_Type) = Not_Compatible then - Not_Match (Expr, A_Type); + Error_Not_Match (Expr, A_Type); return Null_Iir; end if; Res := Sem_Expression (Get_Expression (Expr), N_Type); @@ -4090,7 +4068,7 @@ package body Sem_Expr is and then Are_Basetypes_Compatible (A_Type, Get_Base_Type (Get_Type (Expr))) = Not_Compatible then - Not_Match (Expr, A_Type); + Error_Not_Match (Expr, A_Type); return Null_Iir; end if; return Expr; @@ -4104,7 +4082,7 @@ package body Sem_Expr is Set_Type (Expr, A_Type); return Expr; else - Not_Match (Expr, A_Type); + Error_Not_Match (Expr, A_Type); return Null_Iir; end if; @@ -4117,7 +4095,7 @@ package body Sem_Expr is Set_Type (Expr, A_Type); return Expr; else - Not_Match (Expr, A_Type); + Error_Not_Match (Expr, A_Type); return Null_Iir; end if; @@ -4132,7 +4110,7 @@ package body Sem_Expr is return Null_Iir; end if; if A_Type /= Null_Iir and then Get_Type (Res) /= A_Type then - Not_Match (Res, A_Type); + Error_Not_Match (Res, A_Type); return Null_Iir; end if; return Res; @@ -4148,7 +4126,7 @@ package body Sem_Expr is end if; if not Is_String_Literal_Type (A_Type, Expr) then - Not_Match (Expr, A_Type); + Error_Not_Match (Expr, A_Type); return Null_Iir; else Replace_Type (Expr, A_Type); @@ -4209,6 +4187,10 @@ package body Sem_Expr is (Disp_Node (Expr) & " cannot be used as an expression", Expr); return Null_Iir; + when Iir_Kind_Error => + -- Always ok. + return Expr; + when others => Error_Kind ("sem_expression_ov", Expr); return Null_Iir; @@ -4383,7 +4365,7 @@ package body Sem_Expr is when Iir_Kind_String_Literal8 => if Atype_Defined then if not Is_String_Literal_Type (Atype, Expr) then - Not_Match (Expr, Atype); + Error_Not_Match (Expr, Atype); Set_Type (Expr, Error_Type); else Set_Type (Expr, Atype); @@ -4398,7 +4380,7 @@ package body Sem_Expr is when Iir_Kind_Null_Literal => if Atype_Defined then if not Is_Null_Literal_Type (Atype) then - Not_Match (Expr, Atype); + Error_Not_Match (Expr, Atype); Set_Type (Expr, Error_Type); else Set_Type (Expr, Atype); @@ -4414,7 +4396,7 @@ package body Sem_Expr is | Iir_Kind_Allocator_By_Subtype => if Atype_Defined then if not Is_Null_Literal_Type (Atype) then - Not_Match (Expr, Atype); + Error_Not_Match (Expr, Atype); Set_Type (Expr, Error_Type); else return Sem_Allocator (Expr, Atype); @@ -4462,7 +4444,7 @@ package body Sem_Expr is if Atype in Iir_Wildcard_Types then -- Analyze without known type. Res := Sem_Expression_Ov (Expr, Null_Iir); - if Res = Null_Iir then + if Res = Null_Iir or else Is_Error (Res) then Set_Type (Expr, Error_Type); return Expr; end if; @@ -4474,7 +4456,7 @@ package body Sem_Expr is if Res_Type = Null_Iir then -- No matching type. This is an error. - Not_Match (Expr, Atype); + Error_Not_Match (Expr, Atype); Set_Type (Expr, Error_Type); elsif Is_Defined_Type (Res_Type) then -- Known and defined matching type. @@ -4548,7 +4530,7 @@ package body Sem_Expr is if A_Type /= Null_Iir and then Are_Types_Compatible (Expr_Type, A_Type) = Not_Compatible then - Not_Match (Expr, A_Type); + Error_Not_Match (Expr, A_Type); return Null_Iir; end if; return Expr; @@ -4569,7 +4551,7 @@ package body Sem_Expr is Res := Sem_Expression_Ov (Expr, Null_Iir); else if not Is_String_Literal_Type (A_Type, Expr) then - Not_Match (Expr, A_Type); + Error_Not_Match (Expr, A_Type); return Null_Iir; end if; Set_Type (Expr, A_Type); |