diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 66 | ||||
| -rw-r--r-- | gcc/ada/sem_type.adb | 64 |
2 files changed, 97 insertions, 33 deletions
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index e1aa6b863b2..c35b3a74313 100644 --- a/gcc/ada/sem_ch4.adb +++ b/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; 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 |