From 3aba5ed58e7dec4dd58f9a324cee4ad85fa73dd8 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Fri, 6 Apr 2007 11:27:13 +0200 Subject: [PATCH] sem_type.ads, [...] (Has_Abstract_Interpretation): Make predicate recursive... 2007-04-06 Ed Schonberg Javier Miranda * 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 --- gcc/ada/sem_type.adb | 78 +++++++++++++++++++++++++++++++------------- gcc/ada/sem_type.ads | 4 +-- 2 files changed, 57 insertions(+), 25 deletions(-) diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index a33a39702eca..4b5653a017df 100644 --- 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 63c65ec7bc3d..6932c9d92404 100644 --- 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 -- 2.43.5