Patchwork [Ada] Intrinsic operators with real operands

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 4, 2011, 9:18 a.m.
Message ID <20110804091832.GA5378@adacore.com>
Download mbox | patch
Permalink /patch/108390/
State New
Headers show

Comments

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

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