[Ada] Intrinsic operators with real operands

Submitted by Arnaud Charlet on Aug. 4, 2011, 9:18 a.m.

Details

Message ID 20110804091832.GA5378@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Aug. 4, 2011, 9:18 a.m.
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  <schonberg@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.

Patch hide | download patch | download mbox

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