Skip to content

R
riscv-gcc-1
Commit 0e0eecec by Ed Schonberg Committed by Arnaud Charlet
Options

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
parent b5bd964f
Showing with 97 additions and 33 deletions
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment