sem_type.ads, [...] (Has_Abstract_Interpretation): Make predicate recursive...

2007-04-06  Ed Schonberg  <schonberg@adacore.com>
	    Javier Miranda  <miranda@adacore.com>

	* sem_type.ads, sem_type.adb (Has_Abstract_Interpretation): Make
	predicate recursive, to handle complex expressions on literals whose
	spurious ambiguity comes from the abstract interpretation of some
	subexpression.
	(Interface_Present_In_Ancestor): Add support to concurrent record
	types.
	(Add_One_Interp,Disambiguate): Split Is_Abstract flag into
	Is_Abstract_Subprogram and Is_Abstract_Type.

From-SVN: r123598

diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index a33a39702eca740b44651a7e7184c0387797d6fb..4b5653a017df4c48d866b41ce8a988e05327dfd9 100644 (file)
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -375,7 +375,8 @@ package body Sem_Type is
       --  instance).
 
       elsif In_Instance
-        and then Is_Abstract (E)
+        and then Is_Overloadable (E)
+        and then Is_Abstract_Subprogram (E)
         and then not Is_Dispatching_Operation (E)
       then
          return;
@@ -1008,7 +1009,9 @@ package body Sem_Type is
 
          elsif Ekind (T2) = E_Class_Wide_Type then
             return
-              Covers (T1, Class_Wide_Type (Non_Limited_View (Etype (T2))));
+              Present (Non_Limited_View (Etype (T2)))
+                and then
+                  Covers (T1, Class_Wide_Type (Non_Limited_View (Etype (T2))));
          else
             return False;
          end if;
@@ -1218,18 +1221,41 @@ package body Sem_Type 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;
+            if Nkind (N) not in N_Op
+              or else Ada_Version < Ada_05
+              or else not Is_Overloaded (N)
+              or else No (Universal_Interpretation (N))
+            then
+               return False;
+
+            else
+               E := Get_Name_Entity_Id (Chars (N));
+               while Present (E) loop
+                  if Is_Overloadable (E)
+                    and then Is_Abstract_Subprogram (E)
+                    and then Is_Numeric_Type (Etype (E))
+                  then
+                     return True;
+                  else
+                     E := Homonym (E);
+                  end if;
+               end loop;
+
+               --  Finally, if an operand of the binary operator is itself
+               --  an operator, recurse to see whether its own abstract
+               --  interpretation is responsible for the spurious ambiguity.
+
+               if Nkind (N) in N_Binary_Op then
+                  return Has_Abstract_Interpretation (Left_Opnd (N))
+                    or else Has_Abstract_Interpretation (Right_Opnd (N));
+
+               elsif Nkind (N) in N_Unary_Op then
+                  return Has_Abstract_Interpretation (Right_Opnd (N));
+
                else
-                  E := Homonym (E);
+                  return False;
                end if;
-            end loop;
-
-            return False;
+            end if;
          end Has_Abstract_Interpretation;
 
       --  Start of processing for Remove_Conversions
@@ -1268,6 +1294,12 @@ package body Sem_Type is
                   Act1 := Left_Opnd (N);
                   Act2 := Right_Opnd (N);
 
+                  --  Use type of second formal, so as to include
+                  --  exponentiation, where the exponent may be
+                  --  ambiguous and the result non-universal.
+
+                  Next_Formal (F1);
+
                else
                   return It1;
                end if;
@@ -1314,12 +1346,10 @@ package body Sem_Type is
                      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)
+               elsif Is_Numeric_Type (Etype (F1))
+                 and then
+                   (Has_Abstract_Interpretation (Act1)
+                     or else Has_Abstract_Interpretation (Act2))
                then
                   if It = Disambiguate.It1 then
                      return Disambiguate.It2;
@@ -1716,7 +1746,7 @@ package body Sem_Type is
                         return It2;
                      end if;
                   else
-                     return No_Interp;
+                     return Remove_Conversions;
                   end if;
                end;
 
@@ -2104,6 +2134,10 @@ package body Sem_Type is
          Target_Typ := Typ;
       end if;
 
+      if Is_Concurrent_Record_Type (Target_Typ) then
+         Target_Typ := Corresponding_Concurrent_Type (Target_Typ);
+      end if;
+
       --  In case of concurrent types we can't use the Corresponding Record_Typ
       --  to look for the interface because it is built by the expander (and
       --  hence it is not always available). For this reason we traverse the
@@ -2671,16 +2705,14 @@ package body Sem_Type is
       if B1 = B2 then
          return B1;
 
-      elsif False
-        or else (T1 = Universal_Integer and then Is_Integer_Type (T2))
+      elsif     (T1 = Universal_Integer and then Is_Integer_Type (T2))
         or else (T1 = Universal_Real    and then Is_Real_Type (T2))
         or else (T1 = Universal_Fixed   and then Is_Fixed_Point_Type (T2))
         or else (T1 = Any_Fixed         and then Is_Fixed_Point_Type (T2))
       then
          return B2;
 
-      elsif False
-        or else (T2 = Universal_Integer and then Is_Integer_Type (T1))
+      elsif     (T2 = Universal_Integer and then Is_Integer_Type (T1))
         or else (T2 = Universal_Real    and then Is_Real_Type (T1))
         or else (T2 = Universal_Fixed   and then Is_Fixed_Point_Type (T1))
         or else (T2 = Any_Fixed         and then Is_Fixed_Point_Type (T1))

diff --git a/gcc/ada/sem_type.ads b/gcc/ada/sem_type.ads
index 63c65ec7bc3dc048707572be8fcbd115adf4b35e..6932c9d9240443e0a0bc7e0defd2b0822c9142bc 100644 (file)
--- a/gcc/ada/sem_type.ads
+++ b/gcc/ada/sem_type.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -208,7 +208,7 @@ package Sem_Type is
       Iface : Entity_Id) return Boolean;
    --  Ada 2005 (AI-251): Typ must be a tagged record type/subtype and Iface
    --  must be an abstract interface type. This function is used to check if
-   --  some ancestor of Typ implements Iface.
+   --  Typ or some ancestor of Typ implements Iface.
 
    function Intersect_Types (L, R : Node_Id) return Entity_Id;
    --  Find the common interpretation to two analyzed nodes. If one of the