diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-12-09 17:21:19 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-12-09 17:21:19 +0000 |
commit | d177360bc6368f932317cdccdf6dd83e02c776d3 (patch) | |
tree | 23ddc8663a59b1e79ef4abc43299d6f2168f83b6 /gcc/ada/sem_type.adb | |
parent | b8dfeefc7d6be45300028c6139453894980df1f0 (diff) | |
download | gcc-d177360bc6368f932317cdccdf6dd83e02c776d3.tar.gz |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@108302 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/sem_type.adb')
-rw-r--r-- | gcc/ada/sem_type.adb | 64 |
1 files changed, 63 insertions, 1 deletions
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 94c4c5c060e..b4218db925e 100644 --- a/gcc/ada/sem_type.adb +++ b/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 |