OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Ed Schonberg 2007-04-06 11:27:13 +02:00 committed by Arnaud Charlet
parent 16ca248a58
commit 3aba5ed58e
2 changed files with 58 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
gcc/ada/sem_type.adb
View File

@ -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;
else
E := Homonym (E);
end if;
end loop;
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;
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
return False;
end if;
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))

4
gcc/ada/sem_type.ads
View File

@ -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