sem_ch4.adb (Remove_Abstract_Operations): Do not apply preference rule…

sem_ch4.adb (Remove_Abstract_Operations): Do not apply preference rule prematurely when operands are universal...

2005-12-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Remove_Abstract_Operations): Do not apply preference
	rule prematurely when operands are universal, remaining ambiguities
	will be removed during resolution.
	Code cleanup.

	* sem_type.adb (Disambiguate): In Ada95 mode, discard interpretations
	that are Ada 2005 functions.
	(Has_Abstract_Interpretation): Subsidiary to
	Remove_Conversions, to remove ambiguities caused by abstract operations
	on numeric types when operands are universal.

From-SVN: r108302

gcc/ada/sem_ch4.adb

@@ -4379,9 +4379,9 @@ package body Sem_Ch4 is
             --  If either operand is a junk operand (e.g. package name), then
             --  post appropriate error messages, but do not complain further.
 
-            --  Note that the use of OR in this test instead of OR ELSE
-            --  is quite deliberate, we may as well check both operands
-            --  in the binary operator case.
+            --  Note that the use of OR in this test instead of OR ELSE is
+            --  quite deliberate, we may as well check both operands in the
+            --  binary operator case.
 
             elsif Junk_Operand (R)
               or (Nkind (N) in N_Binary_Op and then Junk_Operand (L))
@@ -4389,10 +4389,10 @@ package body Sem_Ch4 is
                return;
 
             --  If we have a logical operator, one of whose operands is
-            --  Boolean, then we know that the other operand cannot resolve
-            --  to Boolean (since we got no interpretations), but in that
-            --  case we pretty much know that the other operand should be
-            --  Boolean, so resolve it that way (generating an error)
+            --  Boolean, then we know that the other operand cannot resolve to
+            --  Boolean (since we got no interpretations), but in that case we
+            --  pretty much know that the other operand should be Boolean, so
+            --  resolve it that way (generating an error)
 
             elsif Nkind (N) = N_Op_And
                     or else
@@ -4476,10 +4476,10 @@ package body Sem_Ch4 is
                return;
             end if;
 
-            --  If we fall through then just give general message. Note
-            --  that in the following messages, if the operand is overloaded
-            --  we choose an arbitrary type to complain about, but that is
-            --  probably more useful than not giving a type at all.
+            --  If we fall through then just give general message. Note that in
+            --  the following messages, if the operand is overloaded we choose
+            --  an arbitrary type to complain about, but that is probably more
+            --  useful than not giving a type at all.
 
             if Nkind (N) in N_Unary_Op then
                Error_Msg_Node_2 := Etype (R);
@@ -4543,23 +4543,21 @@ package body Sem_Ch4 is
       It           : Interp;
       Abstract_Op  : Entity_Id := Empty;
 
-      --  AI-310: If overloaded, remove abstract non-dispatching
-      --  operations. We activate this if either extensions are
-      --  enabled, or if the abstract operation in question comes
-      --  from a predefined file. This latter test allows us to
-      --  use abstract to make operations invisible to users. In
-      --  particular, if type Address is non-private and abstract
-      --  subprograms are used to hide its operators, they will be
-      --  truly hidden.
+      --  AI-310: If overloaded, remove abstract non-dispatching operations. We
+      --  activate this if either extensions are enabled, or if the abstract
+      --  operation in question comes from a predefined file. This latter test
+      --  allows us to use abstract to make operations invisible to users. In
+      --  particular, if type Address is non-private and abstract subprograms
+      --  are used to hide its operators, they will be truly hidden.
 
       type Operand_Position is (First_Op, Second_Op);
       Univ_Type : constant Entity_Id := Universal_Interpretation (N);
 
       procedure Remove_Address_Interpretations (Op : Operand_Position);
-      --  Ambiguities may arise when the operands are literal and the
-      --  address operations in s-auxdec are visible. In that case, remove
-      --  the interpretation of a literal as Address, to retain the semantics
-      --  of Address as a private type.
+      --  Ambiguities may arise when the operands are literal and the address
+      --  operations in s-auxdec are visible. In that case, remove the
+      --  interpretation of a literal as Address, to retain the semantics of
+      --  Address as a private type.
 
       ------------------------------------
       -- Remove_Address_Interpretations --
@@ -4627,10 +4625,11 @@ package body Sem_Ch4 is
                      Present (Universal_Interpretation (Left_Opnd (N)));
 
                begin
-                  if U1 and then not U2 then
+                  if U1 then
                      Remove_Address_Interpretations (Second_Op);
+                  end if;
 
-                  elsif U2 and then not U1 then
+                  if U2 then
                      Remove_Address_Interpretations (First_Op);
                   end if;
 
@@ -4655,15 +4654,17 @@ package body Sem_Ch4 is
                     and then Present (Univ_Type)
                   then
                      --  If both operands have a universal interpretation,
-                     --  select the predefined operator and discard others.
+                     --  it is still necessary to remove interpretations that
+                     --  yield Address. Any remaining ambiguities will be
+                     --  removed in Disambiguate.
 
                      Get_First_Interp (N, I, It);
                      while Present (It.Nam) loop
-                        if Scope (It.Nam) = Standard_Standard then
-                           Set_Etype (N, Univ_Type);
+                        if Is_Descendent_Of_Address (It.Typ) then
+                           Remove_Interp (I);
+
+                        elsif not Is_Type (It.Nam) then
                            Set_Entity (N, It.Nam);
-                           Set_Is_Overloaded (N, False);
-                           exit;
                         end if;
 
                         Get_Next_Interp (I, It);
@@ -4690,10 +4691,11 @@ package body Sem_Ch4 is
                         Present (Universal_Interpretation (Next (Arg1)));
 
             begin
-               if U1 and then not U2 then
+               if U1 then
                   Remove_Address_Interpretations (First_Op);
+               end if;
 
-               elsif U2 and then not U1 then
+               if U2 then
                   Remove_Address_Interpretations (Second_Op);
                end if;
 

gcc/ada/sem_type.adb

@@ -1019,6 +1019,10 @@ package body Sem_Type is
       --  pathology in the other direction with calls whose multiple overloaded
       --  actuals make them truly unresolvable.
 
+      --  The new rules concerning abstract operations create additional
+      --  for special handling of expressions with universal operands, See
+      --  comments to Has_Abstract_Interpretation below.
+
       ------------------------
       --  In_Generic_Actual --
       ------------------------
@@ -1105,12 +1109,43 @@ package body Sem_Type is
          Act1 : Node_Id;
          Act2 : Node_Id;
 
+         function Has_Abstract_Interpretation (N : Node_Id) return Boolean;
+         --  If an operation has universal operands the universal operation
+         --  is present among its interpretations. If there is an abstract
+         --  interpretation for the operator, with a numeric result, this
+         --  interpretation was already removed in sem_ch4, but the universal
+         --  one is still visible. We must rescan the list of operators and
+         --  remove the universal interpretation to resolve the ambiguity.
+
+         ---------------------------------
+         -- Has_Abstract_Interpretation --
+         ---------------------------------
+
+         function Has_Abstract_Interpretation (N : Node_Id) return Boolean is
+            E : Entity_Id;
+
+         begin
+            E := Current_Entity (N);
+            while Present (E) loop
+               if Is_Abstract (E)
+                 and then Is_Numeric_Type (Etype (E))
+               then
+                  return True;
+               else
+                  E := Homonym (E);
+               end if;
+            end loop;
+
+            return False;
+         end Has_Abstract_Interpretation;
+
+      --  Start of processing for Remove_ConversionsMino
+
       begin
          It1 := No_Interp;
 
          Get_First_Interp (N, I, It);
          while Present (It.Typ) loop
-
             if not Is_Overloadable (It.Nam) then
                return No_Interp;
             end if;
@@ -1185,6 +1220,19 @@ package body Sem_Type is
                   else
                      It1 := It;
                   end if;
+
+               elsif Nkind (Act1) in N_Op
+                 and then Is_Overloaded (Act1)
+                 and then Present (Universal_Interpretation (Act1))
+                 and then Is_Numeric_Type (Etype (F1))
+                 and then Ada_Version >= Ada_05
+                 and then Has_Abstract_Interpretation (Act1)
+               then
+                  if It = Disambiguate.It1 then
+                     return Disambiguate.It2;
+                  elsif It = Disambiguate.It2 then
+                     return Disambiguate.It1;
+                  end if;
                end if;
             end if;
 
@@ -1267,6 +1315,19 @@ package body Sem_Type is
       It2  := It;
       Nam2 := It.Nam;
 
+      if Ada_Version < Ada_05 then
+
+         --  Check whether one of the entities is an Ada 2005 entity and we are
+         --  operating in an earlier mode, in which case we discard the Ada
+         --  2005 entity, so that we get proper Ada 95 overload resolution.
+
+         if Is_Ada_2005 (Nam1) then
+            return It2;
+         elsif Is_Ada_2005 (Nam2) then
+            return It1;
+         end if;
+      end if;
+
       --  If the context is universal, the predefined operator is preferred.
       --  This includes bounds in numeric type declarations, and expressions
       --  in type conversions. If no interpretation yields a universal type,
@@ -1912,6 +1973,7 @@ package body Sem_Type is
          if Present (Interface_List (Parent (Target_Typ))) then
             declare
                AI : Node_Id;
+
             begin
                AI := First (Interface_List (Parent (Target_Typ)));
                while Present (AI) loop