From c307230d4049818a2710cd7ef9303f74e107facc Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Fri, 11 Mar 2022 19:20:50 +0100 Subject: vhdl: check association restrictions for operators. Fix #1999 --- src/vhdl/vhdl-sem_assocs.adb | 317 +++++++++++++++++++++---------------------- src/vhdl/vhdl-sem_assocs.ads | 5 + src/vhdl/vhdl-sem_expr.adb | 29 ++-- 3 files changed, 181 insertions(+), 170 deletions(-) (limited to 'src') diff --git a/src/vhdl/vhdl-sem_assocs.adb b/src/vhdl/vhdl-sem_assocs.adb index f727b87c0..4652eca1a 100644 --- a/src/vhdl/vhdl-sem_assocs.adb +++ b/src/vhdl/vhdl-sem_assocs.adb @@ -239,14 +239,167 @@ package body Vhdl.Sem_Assocs is +Inter); end Check_Parameter_Association_Restriction; + procedure Check_Subprogram_Association_Expression + (Formal : Iir; Actual : Iir; Assoc : Iir; Loc : Iir) + is + Prefix : Iir; + Object : Iir; + begin + Object := Name_To_Object (Actual); + if Object /= Null_Iir then + Prefix := Get_Object_Prefix (Object); + else + Prefix := Actual; + end if; + + case Get_Kind (Formal) is + when Iir_Kind_Interface_Signal_Declaration => + -- LRM93 2.1.1 + -- In a subprogram call, the actual designator + -- associated with a formal parameter of class + -- signal must be a signal. + case Get_Kind (Prefix) is + when Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kinds_Signal_Attribute => + -- LRM93 2.1.1.2 + -- If an actual signal is associated with + -- a signal parameter of any mode, the actual + -- must be denoted by a static signal name. + if Get_Name_Staticness (Object) < Globally then + Error_Msg_Sem + (+Actual, "actual signal must be a static name"); + else + -- Inherit has_active_flag. + Set_Has_Active_Flag + (Prefix, Get_Has_Active_Flag (Formal)); + end if; + when others => + Error_Msg_Sem + (+Loc, "signal parameter requires a signal expression"); + end case; + + case Get_Kind (Prefix) is + when Iir_Kind_Interface_Signal_Declaration => + Check_Parameter_Association_Restriction + (Formal, Prefix, Loc); + when Iir_Kind_Guard_Signal_Declaration => + if Get_Mode (Formal) /= Iir_In_Mode then + Error_Msg_Sem + (+Loc, "cannot associate a guard signal with " + & Get_Mode_Name (Get_Mode (Formal)) + & " %n", +Formal); + end if; + when Iir_Kinds_Signal_Attribute => + if Get_Mode (Formal) /= Iir_In_Mode then + Error_Msg_Sem + (+Loc, "cannot associate a signal attribute with " + & Get_Mode_Name (Get_Mode (Formal)) + & " %n", +Formal); + end if; + when others => + null; + end case; + + -- LRM 2.1.1.2 Signal parameters + -- It is an error if a conversion function or type + -- conversion appears in either the formal part or the + -- actual part of an association element that associates + -- an actual signal with a formal signal parameter. + if Assoc /= Null_Iir + and then (Get_Actual_Conversion (Assoc) /= Null_Iir + or Get_Formal_Conversion (Assoc) /= Null_Iir) + then + Error_Msg_Sem + (+Assoc, "conversion are not allowed for signal parameters"); + end if; + when Iir_Kind_Interface_Variable_Declaration => + -- LRM93 2.1.1 + -- The actual designator associated with a formal of + -- class variable must be a variable. + case Get_Kind (Prefix) is + when Iir_Kind_Interface_Variable_Declaration => + Check_Parameter_Association_Restriction + (Formal, Prefix, Loc); + when Iir_Kind_Variable_Declaration + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference => + null; + when Iir_Kind_Interface_File_Declaration + | Iir_Kind_File_Declaration => + -- LRM87 4.3.1.4 + -- Such an object is a member of the variable + -- class of objects; + if Flags.Vhdl_Std >= Vhdl_93 + and then not Flags.Flag_Relaxed_Files87 + then + Error_Msg_Sem + (+Loc, "variable parameter cannot be a file (vhdl93)"); + end if; + when others => + Error_Msg_Sem + (+Loc, "variable parameter must be a variable"); + end case; + when Iir_Kind_Interface_File_Declaration => + -- LRM93 2.1.1 + -- The actual designator associated with a formal + -- of class file must be a file. + case Get_Kind (Prefix) is + when Iir_Kind_Interface_File_Declaration + | Iir_Kind_File_Declaration => + null; + when Iir_Kind_Variable_Declaration + | Iir_Kind_Interface_Variable_Declaration => + if Flags.Vhdl_Std >= Vhdl_93 + and then not Flags.Flag_Relaxed_Files87 + then + Error_Msg_Sem + (+Loc, "file parameter must be a file (vhdl93)"); + end if; + when others => + Error_Msg_Sem (+Loc, "file parameter must be a file"); + end case; + + -- LRM 2.1.1.3 File parameters + -- It is an error if an association element associates + -- an actual with a formal parameter of a file type and + -- that association element contains a conversion + -- function or type conversion. + if Assoc /= Null_Iir + and then (Get_Actual_Conversion (Assoc) /= Null_Iir + or Get_Formal_Conversion (Assoc) /= Null_Iir) + then + Error_Msg_Sem (+Assoc, "conversion are not allowed " + & "for file parameters"); + end if; + when Iir_Kind_Interface_Constant_Declaration => + -- LRM93 2.1.1 + -- The actual designator associated with a formal of + -- class constant must be an expression. + -- GHDL: unless this is in a formal_part. + if Assoc = Null_Iir or else not Get_In_Formal_Flag (Assoc) then + Check_Read (Actual); + end if; + when others => + Error_Kind ("check_subprogram_association_expression", Formal); + end case; + + case Get_Kind (Prefix) is + when Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration => + Set_Use_Flag (Prefix, True); + when others => + null; + end case; + end Check_Subprogram_Association_Expression; + procedure Check_Subprogram_Associations (Inter_Chain : Iir; Assoc_Chain : Iir) is Assoc : Iir; Formal_Inter : Iir; Actual : Iir; - Prefix : Iir; - Object : Iir; Inter : Iir; begin Assoc := Assoc_Chain; @@ -256,166 +409,12 @@ package body Vhdl.Sem_Assocs is case Get_Kind (Assoc) is when Iir_Kind_Association_Element_Open => if Get_Default_Value (Formal_Inter) = Null_Iir then - Error_Msg_Sem - (+Assoc, "no parameter for %n", +Formal_Inter); + Error_Msg_Sem (+Assoc, "no parameter for %n", +Formal_Inter); end if; when Iir_Kind_Association_Element_By_Expression => Actual := Get_Actual (Assoc); - Object := Name_To_Object (Actual); - if Object /= Null_Iir then - Prefix := Get_Object_Prefix (Object); - else - Prefix := Actual; - end if; - - case Get_Kind (Formal_Inter) is - when Iir_Kind_Interface_Signal_Declaration => - -- LRM93 2.1.1 - -- In a subprogram call, the actual designator - -- associated with a formal parameter of class - -- signal must be a signal. - case Get_Kind (Prefix) is - when Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kinds_Signal_Attribute => - -- LRM93 2.1.1.2 - -- If an actual signal is associated with - -- a signal parameter of any mode, the actual - -- must be denoted by a static signal name. - if Get_Name_Staticness (Object) < Globally then - Error_Msg_Sem - (+Actual, - "actual signal must be a static name"); - else - -- Inherit has_active_flag. - Set_Has_Active_Flag - (Prefix, Get_Has_Active_Flag (Formal_Inter)); - end if; - when others => - Error_Msg_Sem - (+Assoc, - "signal parameter requires a signal expression"); - end case; - - case Get_Kind (Prefix) is - when Iir_Kind_Interface_Signal_Declaration => - Check_Parameter_Association_Restriction - (Formal_Inter, Prefix, Assoc); - when Iir_Kind_Guard_Signal_Declaration => - if Get_Mode (Formal_Inter) /= Iir_In_Mode then - Error_Msg_Sem - (+Assoc, - "cannot associate a guard signal with " - & Get_Mode_Name (Get_Mode (Formal_Inter)) - & " %n", +Formal_Inter); - end if; - when Iir_Kinds_Signal_Attribute => - if Get_Mode (Formal_Inter) /= Iir_In_Mode then - Error_Msg_Sem - (+Assoc, - "cannot associate a signal attribute with " - & Get_Mode_Name (Get_Mode (Formal_Inter)) - & " %n", +Formal_Inter); - end if; - when others => - null; - end case; - - -- LRM 2.1.1.2 Signal parameters - -- It is an error if a conversion function or type - -- conversion appears in either the formal part or the - -- actual part of an association element that associates - -- an actual signal with a formal signal parameter. - if Get_Actual_Conversion (Assoc) /= Null_Iir - or Get_Formal_Conversion (Assoc) /= Null_Iir - then - Error_Msg_Sem - (+Assoc, - "conversion are not allowed for signal parameters"); - end if; - when Iir_Kind_Interface_Variable_Declaration => - -- LRM93 2.1.1 - -- The actual designator associated with a formal of - -- class variable must be a variable. - case Get_Kind (Prefix) is - when Iir_Kind_Interface_Variable_Declaration => - Check_Parameter_Association_Restriction - (Formal_Inter, Prefix, Assoc); - when Iir_Kind_Variable_Declaration - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference => - null; - when Iir_Kind_Interface_File_Declaration - | Iir_Kind_File_Declaration => - -- LRM87 4.3.1.4 - -- Such an object is a member of the variable - -- class of objects; - if Flags.Vhdl_Std >= Vhdl_93 - and then not Flags.Flag_Relaxed_Files87 - then - Error_Msg_Sem - (+Assoc, "variable parameter cannot be a " - & "file (vhdl93)"); - end if; - when others => - Error_Msg_Sem - (+Assoc, "variable parameter must be a variable"); - end case; - when Iir_Kind_Interface_File_Declaration => - -- LRM93 2.1.1 - -- The actual designator associated with a formal - -- of class file must be a file. - case Get_Kind (Prefix) is - when Iir_Kind_Interface_File_Declaration - | Iir_Kind_File_Declaration => - null; - when Iir_Kind_Variable_Declaration - | Iir_Kind_Interface_Variable_Declaration => - if Flags.Vhdl_Std >= Vhdl_93 - and then not Flags.Flag_Relaxed_Files87 - then - Error_Msg_Sem - (+Assoc, - "file parameter must be a file (vhdl93)"); - end if; - when others => - Error_Msg_Sem - (+Assoc, "file parameter must be a file"); - end case; - - -- LRM 2.1.1.3 File parameters - -- It is an error if an association element associates - -- an actual with a formal parameter of a file type and - -- that association element contains a conversion - -- function or type conversion. - if Get_Actual_Conversion (Assoc) /= Null_Iir - or Get_Formal_Conversion (Assoc) /= Null_Iir - then - Error_Msg_Sem (+Assoc, "conversion are not allowed " - & "for file parameters"); - end if; - when Iir_Kind_Interface_Constant_Declaration => - -- LRM93 2.1.1 - -- The actual designator associated with a formal of - -- class constant must be an expression. - -- GHDL: unless this is in a formal_part. - if not Get_In_Formal_Flag (Assoc) then - Check_Read (Actual); - end if; - when others => - Error_Kind - ("check_subprogram_association(3)", Formal_Inter); - end case; - - case Get_Kind (Prefix) is - when Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration => - Set_Use_Flag (Prefix, True); - when others => - null; - end case; - + Check_Subprogram_Association_Expression + (Formal_Inter, Actual, Assoc, Assoc); when Iir_Kind_Association_Element_By_Individual => null; when others => diff --git a/src/vhdl/vhdl-sem_assocs.ads b/src/vhdl/vhdl-sem_assocs.ads index 9194ddc1f..f59ecb3d3 100644 --- a/src/vhdl/vhdl-sem_assocs.ads +++ b/src/vhdl/vhdl-sem_assocs.ads @@ -47,6 +47,11 @@ package Vhdl.Sem_Assocs is Loc : Iir; Match : out Compatibility_Level); + -- Check association for expression ACTUAL to interface FORMAL. + -- ASSOC may be null for operator. + procedure Check_Subprogram_Association_Expression + (Formal : Iir; Actual : Iir; Assoc : Iir; Loc : Iir); + -- Do port Sem_Association_Chain checks for subprograms. procedure Check_Subprogram_Associations (Inter_Chain : Iir; Assoc_Chain : Iir); diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb index 04a73071c..2719f86cf 100644 --- a/src/vhdl/vhdl-sem_expr.adb +++ b/src/vhdl/vhdl-sem_expr.adb @@ -1747,38 +1747,45 @@ package body Vhdl.Sem_Expr is is Is_Dyadic : constant Boolean := Get_Kind (Expr) in Iir_Kinds_Dyadic_Operator; - Interface_Chain : Iir; - Err : Boolean; - Left : Iir; - Left_Type : Iir; - Right : Iir; - Right_Type : Iir; + Inter : Iir; + Err : Boolean; + Left : Iir; + Left_Type : Iir; + Right : Iir; + Right_Type : Iir; begin Set_Type (Expr, Get_Return_Type (Decl)); - Interface_Chain := Get_Interface_Declaration_Chain (Decl); + Inter := Get_Interface_Declaration_Chain (Decl); Err := False; + + -- Left operand (or single operand) Left := Get_Left (Expr); - Left_Type := Get_Type (Interface_Chain); + Left_Type := Get_Type (Inter); if Is_Overloaded (Left) then Left := Sem_Expression_Ov (Left, Get_Base_Type (Left_Type)); if Left = Null_Iir then Err := True; end if; end if; - Check_Read (Left); + Check_Subprogram_Association_Expression (Inter, Left, Null_Iir, Left); Set_Left (Expr, Left); + + -- Right operand if Is_Dyadic then Right := Get_Right (Expr); - Right_Type := Get_Type (Get_Chain (Interface_Chain)); + Inter := Get_Chain (Inter); + Right_Type := Get_Type (Inter); if Is_Overloaded (Right) then Right := Sem_Expression_Ov (Right, Get_Base_Type (Right_Type)); if Right = Null_Iir then Err := True; end if; end if; - Check_Read (Right); + Check_Subprogram_Association_Expression + (Inter, Right, Null_Iir, Right); Set_Right (Expr, Right); end if; + if not Err then Set_Implementation (Expr, Decl); Sem_Subprogram_Call_Finish (Expr, Decl); -- cgit v1.2.3