[COMMITTED,30/30] ada: Reference to nonexistent operator in reduction expression accepted
Checks
Commit Message
From: Steve Baird <baird@adacore.com>
In some cases, a reduction expression that references the (nonexistent)
"+" operator of a generic formal private type is incorrectly accepted.
gcc/ada/
* sem_attr.adb (Resolve_Attribute.Proper_Op): When resolving the
name of the reducer subprogram in a reduction expression,
Proper_Op treats references to operators defined in Standard
specially. Disable this special treatment if the type of the
reduction expression is not the right class of type for the
operator, or if a new Boolean parameter (named "Strict") is True.
(Resolve_Attribute): In the overloaded case, iterate over the
reducer subprogram candidates twice. First with Strict => True and
then, if no good intepretation is found, with Strict => False.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_attr.adb | 110 ++++++++++++++++++++++++++++++++-----------
1 file changed, 83 insertions(+), 27 deletions(-)
@@ -12600,21 +12600,30 @@ package body Sem_Attr is
when Attribute_Reduce =>
declare
- E1 : constant Node_Id := First (Expressions (N));
- E2 : constant Node_Id := Next (E1);
+ Reducer_Subp_Name : constant Node_Id := First (Expressions (N));
+ Init_Value_Exp : constant Node_Id :=
+ Next (Reducer_Subp_Name);
Op : Entity_Id := Empty;
Index : Interp_Index;
It : Interp;
- function Proper_Op (Op : Entity_Id) return Boolean;
+
+ function Proper_Op
+ (Op : Entity_Id;
+ Strict : Boolean := False) return Boolean;
+ -- Is Op a suitable reducer subprogram?
+ -- Strict indicates whether ops found in Standard should be
+ -- considered even if Typ is not a predefined type.
---------------
-- Proper_Op --
---------------
- function Proper_Op (Op : Entity_Id) return Boolean is
+ function Proper_Op
+ (Op : Entity_Id;
+ Strict : Boolean := False) return Boolean
+ is
F1, F2 : Entity_Id;
-
begin
F1 := First_Formal (Op);
if No (F1) then
@@ -12630,42 +12639,89 @@ package body Sem_Attr is
return Ekind (F1) = E_In_Out_Parameter
and then Covers (Typ, Etype (F1));
+ elsif Covers (Typ, Etype (Op)) then
+ return True;
+
+ elsif Ekind (Op) = E_Operator
+ and then Scope (Op) = Standard_Standard
+ and then not Strict
+ then
+ declare
+ Op_Chars : constant Any_Operator_Name := Chars (Op);
+ -- Nonassociative ops like division are unlikely
+ -- to come up in practice, but they are legal.
+ begin
+ case Op_Chars is
+ when Name_Op_Add
+ | Name_Op_Subtract
+ | Name_Op_Multiply
+ | Name_Op_Divide
+ | Name_Op_Expon
+ =>
+ return Is_Numeric_Type (Typ);
+
+ when Name_Op_Mod | Name_Op_Rem =>
+ return Is_Numeric_Type (Typ)
+ and then Is_Discrete_Type (Typ);
+
+ when Name_Op_And | Name_Op_Or | Name_Op_Xor =>
+ -- No Boolean array operators in Standard
+ return Is_Boolean_Type (Typ)
+ or else Is_Modular_Integer_Type (Typ);
+
+ when Name_Op_Concat =>
+ return Is_Array_Type (Typ)
+ and then Number_Dimensions (Typ) = 1;
+
+ when Name_Op_Eq | Name_Op_Ne
+ | Name_Op_Lt | Name_Op_Le
+ | Name_Op_Gt | Name_Op_Ge
+ =>
+ return Is_Boolean_Type (Typ);
+
+ when Name_Op_Abs | Name_Op_Not =>
+ -- unary ops were already handled
+ pragma Assert (False);
+ raise Program_Error;
+ end case;
+ end;
else
- return
- (Ekind (Op) = E_Operator
- and then Scope (Op) = Standard_Standard)
- or else Covers (Typ, Etype (Op));
+ return False;
end if;
end if;
end Proper_Op;
begin
- Resolve (E2, Typ);
- if Is_Overloaded (E1) then
- Get_First_Interp (E1, Index, It);
- while Present (It.Nam) loop
- if Proper_Op (It.Nam) then
- Op := It.Nam;
- Set_Entity (E1, Op);
- exit;
- end if;
+ Resolve (Init_Value_Exp, Typ);
+ if Is_Overloaded (Reducer_Subp_Name) then
+ Outer :
+ for Retry in Boolean loop
+ Get_First_Interp (Reducer_Subp_Name, Index, It);
+ while Present (It.Nam) loop
+ if Proper_Op (It.Nam, Strict => not Retry) then
+ Op := It.Nam;
+ Set_Entity (Reducer_Subp_Name, Op);
+ exit Outer;
+ end if;
- Get_Next_Interp (Index, It);
- end loop;
+ Get_Next_Interp (Index, It);
+ end loop;
+ end loop Outer;
- elsif Nkind (E1) = N_Attribute_Reference
- and then (Attribute_Name (E1) = Name_Max
- or else Attribute_Name (E1) = Name_Min)
+ elsif Nkind (Reducer_Subp_Name) = N_Attribute_Reference
+ and then (Attribute_Name (Reducer_Subp_Name) = Name_Max
+ or else Attribute_Name (Reducer_Subp_Name) = Name_Min)
then
- Op := E1;
+ Op := Reducer_Subp_Name;
- elsif Proper_Op (Entity (E1)) then
- Op := Entity (E1);
+ elsif Proper_Op (Entity (Reducer_Subp_Name)) then
+ Op := Entity (Reducer_Subp_Name);
Set_Etype (N, Typ);
end if;
if No (Op) then
- Error_Msg_N ("No visible subprogram for reduction", E1);
+ Error_Msg_N ("No suitable reducer subprogram found",
+ Reducer_Subp_Name);
end if;
end;