If a function call resolves to an operator that is declared intrinsic, the function call is replaced by an operator mode with the same operands. If the result type is private the operands have to be converted to the underlying predefined type (usually a numeric type). However, if an operand is a real literal, a conversion is not meaningful, and a qualified expression must be used instead.
Execution of the following program must yield: 1.40000000000000E+01 --- procedure Real_Test is package P is type T is private; C : constant T; function "*" (X : T; Y : Long_Float) return T; procedure Display (Obj : T); private type T is new Long_Float; pragma Import (Intrinsic, "*"); C : constant T := 4.0; end P; package body P is procedure Display (Obj : T) is begin Put_Line (T'Image (Obj)); end; end; use P; B : T; begin B := C * 3.5; Display (B); end; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-04 Ed Schonberg <schonb...@adacore.com> * sem_res.adb (Resolve_Intrinsic_Operator): if the result type is private and one of the operands is a real literal, use a qualified expression rather than a conversion which is not meaningful to the back-end.
Index: sem_res.adb =================================================================== --- sem_res.adb (revision 177335) +++ sem_res.adb (working copy) @@ -5261,6 +5261,9 @@ -- decrease false positives, without losing too many good -- warnings. The idea is that these previous statements -- may affect global variables the procedure depends on. + -- We also exclude raise statements, that may arise from + -- constraint checks and are probably unrelated to the + -- intended control flow. if Nkind (N) = N_Procedure_Call_Statement and then Is_List_Member (N) @@ -5270,7 +5273,10 @@ begin P := Prev (N); while Present (P) loop - if Nkind (P) /= N_Assignment_Statement then + if not Nkind_In (P, + N_Assignment_Statement, + N_Raise_Constraint_Error) + then exit Scope_Loop; end if; @@ -7026,6 +7032,28 @@ Arg1 : Node_Id; Arg2 : Node_Id; + function Convert_Operand (Opnd : Node_Id) return Node_Id; + -- If the operand is a literal, it cannot be the expression in a + -- conversion. Use a qualified expression instead. + + function Convert_Operand (Opnd : Node_Id) return Node_Id is + Loc : constant Source_Ptr := Sloc (Opnd); + Res : Node_Id; + begin + if Nkind_In (Opnd, N_Integer_Literal, N_Real_Literal) then + Res := + Make_Qualified_Expression (Loc, + Subtype_Mark => New_Occurrence_Of (Btyp, Loc), + Expression => Relocate_Node (Opnd)); + Analyze (Res); + + else + Res := Unchecked_Convert_To (Btyp, Opnd); + end if; + + return Res; + end Convert_Operand; + begin -- We must preserve the original entity in a generic setting, so that -- the legality of the operation can be verified in an instance. @@ -7048,12 +7076,13 @@ -- type. if Is_Private_Type (Typ) then - Arg1 := Unchecked_Convert_To (Btyp, Left_Opnd (N)); + Arg1 := Convert_Operand (Left_Opnd (N)); + -- Unchecked_Convert_To (Btyp, Left_Opnd (N)); if Nkind (N) = N_Op_Expon then Arg2 := Unchecked_Convert_To (Standard_Integer, Right_Opnd (N)); else - Arg2 := Unchecked_Convert_To (Btyp, Right_Opnd (N)); + Arg2 := Convert_Operand (Right_Opnd (N)); end if; if Nkind (Arg1) = N_Type_Conversion then