Skip to content

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

sem_res.adb (Resolve_Allocator): Propagate any coextensions that appear in the… 

sem_res.adb (Resolve_Allocator): Propagate any coextensions that appear in the subtree to the current allocator...

2007-08-14  Ed Schonberg  <schonberg@adacore.com>
	    Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_res.adb (Resolve_Allocator): Propagate any coextensions that
	appear in the subtree to the current allocator if it is not a static
	coextension.
	(Resolve_Allocator): Perform cleanup if resolution has determined that
	the allocator is not a coextension.
	(Resolve): Skip an interpretation hidden by an abstract operator only
	when the type of the interpretation matches that of the context.
	(Resolve): When looping through all possible interpretations of a node,
	do not consider those that are hidden by abstract operators.
	(Resolve_Actuals): When verifying that an access to class-wide object
	is an actual  for a controlling formal, ignore anonymous access to
	subprograms whose return type is an access to class_wide type.
	(Resolve_Slice): If the prefix of the slice is a selected component
	whose type depends on discriminants, build its actual subtype before
	applying range checks on the bounds of the slice.
	(Valid_Conversion): In an instance or inlined body, compare root types,
	to prevent anomalies between private and public views.
	(Resolve): Improve error message for ambiguous fixed multiplication
	expressions that involve universal_fixed multiplying operations.

From-SVN: r127447
parent 11560bcc
Showing with 167 additions and 74 deletions
gcc/ada/sem_res.adb
...@@ -522,7 +522,7 @@ package body Sem_Res is ...@@ -522,7 +522,7 @@ package body Sem_Res is
-- Warn about the danger -- Warn about the danger
Error_Msg_N Error_Msg_N
("creation of & object may raise Storage_Error?", ("?creation of & object may raise Storage_Error!",
Scope (Disc)); Scope (Disc));
<<No_Danger>> <<No_Danger>>
...@@ -732,7 +732,7 @@ package body Sem_Res is ...@@ -732,7 +732,7 @@ package body Sem_Res is
-- for generating a stub function -- for generating a stub function
if Nkind (Parent (N)) = N_Return_Statement if Nkind (Parent (N)) = N_Simple_Return_Statement
and then Same_Argument_List and then Same_Argument_List
then then
exit when not Is_List_Member (Parent (N)); exit when not Is_List_Member (Parent (N));
...@@ -768,8 +768,8 @@ package body Sem_Res is ...@@ -768,8 +768,8 @@ package body Sem_Res is
end if; end if;
end loop; end loop;
Error_Msg_N ("possible infinite recursion?", N); Error_Msg_N ("!?possible infinite recursion", N);
Error_Msg_N ("\Storage_Error may be raised at run time?", N); Error_Msg_N ("\!?Storage_Error may be raised at run time", N);
return True; return True;
end Check_Infinite_Recursion; end Check_Infinite_Recursion;
...@@ -793,29 +793,42 @@ package body Sem_Res is ...@@ -793,29 +793,42 @@ package body Sem_Res is
------------- -------------
function Uses_SS (T : Entity_Id) return Boolean is function Uses_SS (T : Entity_Id) return Boolean is
Comp : Entity_Id; Comp : Entity_Id;
Expr : Node_Id; Expr : Node_Id;
Full_Type : Entity_Id := Underlying_Type (T);
begin begin
if Is_Controlled (T) then -- Normally we want to use the underlying type, but if it's not set
-- then continue with T.
if not Present (Full_Type) then
Full_Type := T;
end if;
if Is_Controlled (Full_Type) then
return False; return False;
elsif Is_Array_Type (T) then elsif Is_Array_Type (Full_Type) then
return Uses_SS (Component_Type (T)); return Uses_SS (Component_Type (Full_Type));
elsif Is_Record_Type (T) then elsif Is_Record_Type (Full_Type) then
Comp := First_Component (T); Comp := First_Component (Full_Type);
while Present (Comp) loop while Present (Comp) loop
if Ekind (Comp) = E_Component if Ekind (Comp) = E_Component
and then Nkind (Parent (Comp)) = N_Component_Declaration and then Nkind (Parent (Comp)) = N_Component_Declaration
then then
Expr := Expression (Parent (Comp)); -- The expression for a dynamic component may be rewritten
-- as a dereference, so retrieve original node.
Expr := Original_Node (Expression (Parent (Comp)));
-- The expression for a dynamic component may be -- Return True if the expression is a call to a function
-- rewritten as a dereference. Retrieve original -- (including an attribute function such as Image) with
-- call. -- a result that requires a transient scope.
if Nkind (Original_Node (Expr)) = N_Function_Call if (Nkind (Expr) = N_Function_Call
or else (Nkind (Expr) = N_Attribute_Reference
and then Present (Expressions (Expr))))
and then Requires_Transient_Scope (Etype (Expr)) and then Requires_Transient_Scope (Etype (Expr))
then then
return True; return True;
...@@ -1374,23 +1387,40 @@ package body Sem_Res is ...@@ -1374,23 +1387,40 @@ package body Sem_Res is
begin begin
if Is_Binary then if Is_Binary then
if Op_Name = Name_Op_And then Kind := N_Op_And; if Op_Name = Name_Op_And then
elsif Op_Name = Name_Op_Or then Kind := N_Op_Or; Kind := N_Op_And;
elsif Op_Name = Name_Op_Xor then Kind := N_Op_Xor; elsif Op_Name = Name_Op_Or then
elsif Op_Name = Name_Op_Eq then Kind := N_Op_Eq; Kind := N_Op_Or;
elsif Op_Name = Name_Op_Ne then Kind := N_Op_Ne; elsif Op_Name = Name_Op_Xor then
elsif Op_Name = Name_Op_Lt then Kind := N_Op_Lt; Kind := N_Op_Xor;
elsif Op_Name = Name_Op_Le then Kind := N_Op_Le; elsif Op_Name = Name_Op_Eq then
elsif Op_Name = Name_Op_Gt then Kind := N_Op_Gt; Kind := N_Op_Eq;
elsif Op_Name = Name_Op_Ge then Kind := N_Op_Ge; elsif Op_Name = Name_Op_Ne then
elsif Op_Name = Name_Op_Add then Kind := N_Op_Add; Kind := N_Op_Ne;
elsif Op_Name = Name_Op_Subtract then Kind := N_Op_Subtract; elsif Op_Name = Name_Op_Lt then
elsif Op_Name = Name_Op_Concat then Kind := N_Op_Concat; Kind := N_Op_Lt;
elsif Op_Name = Name_Op_Multiply then Kind := N_Op_Multiply; elsif Op_Name = Name_Op_Le then
elsif Op_Name = Name_Op_Divide then Kind := N_Op_Divide; Kind := N_Op_Le;
elsif Op_Name = Name_Op_Mod then Kind := N_Op_Mod; elsif Op_Name = Name_Op_Gt then
elsif Op_Name = Name_Op_Rem then Kind := N_Op_Rem; Kind := N_Op_Gt;
elsif Op_Name = Name_Op_Expon then Kind := N_Op_Expon; elsif Op_Name = Name_Op_Ge then
Kind := N_Op_Ge;
elsif Op_Name = Name_Op_Add then
Kind := N_Op_Add;
elsif Op_Name = Name_Op_Subtract then
Kind := N_Op_Subtract;
elsif Op_Name = Name_Op_Concat then
Kind := N_Op_Concat;
elsif Op_Name = Name_Op_Multiply then
Kind := N_Op_Multiply;
elsif Op_Name = Name_Op_Divide then
Kind := N_Op_Divide;
elsif Op_Name = Name_Op_Mod then
Kind := N_Op_Mod;
elsif Op_Name = Name_Op_Rem then
Kind := N_Op_Rem;
elsif Op_Name = Name_Op_Expon then
Kind := N_Op_Expon;
else else
raise Program_Error; raise Program_Error;
end if; end if;
...@@ -1398,10 +1428,14 @@ package body Sem_Res is ...@@ -1398,10 +1428,14 @@ package body Sem_Res is
-- Unary operators -- Unary operators
else else
if Op_Name = Name_Op_Add then Kind := N_Op_Plus; if Op_Name = Name_Op_Add then
elsif Op_Name = Name_Op_Subtract then Kind := N_Op_Minus; Kind := N_Op_Plus;
elsif Op_Name = Name_Op_Abs then Kind := N_Op_Abs; elsif Op_Name = Name_Op_Subtract then
elsif Op_Name = Name_Op_Not then Kind := N_Op_Not; Kind := N_Op_Minus;
elsif Op_Name = Name_Op_Abs then
Kind := N_Op_Abs;
elsif Op_Name = Name_Op_Not then
Kind := N_Op_Not;
else else
raise Program_Error; raise Program_Error;
end if; end if;
...@@ -1746,7 +1780,7 @@ package body Sem_Res is ...@@ -1746,7 +1780,7 @@ package body Sem_Res is
Interp_Loop : while Present (It.Typ) loop Interp_Loop : while Present (It.Typ) loop
-- We are only interested in interpretations that are compatible -- We are only interested in interpretations that are compatible
-- with the expected type, any other interpretations are ignored -- with the expected type, any other interpretations are ignored.
if not Covers (Typ, It.Typ) then if not Covers (Typ, It.Typ) then
if Debug_Flag_V then if Debug_Flag_V then
...@@ -1755,6 +1789,20 @@ package body Sem_Res is ...@@ -1755,6 +1789,20 @@ package body Sem_Res is
end if; end if;
else else
-- Skip the current interpretation if it is disabled by an
-- abstract operator. This action is performed only when the
-- type against which we are resolving is the same as the
-- type of the interpretation.
if Ada_Version >= Ada_05
and then It.Typ = Typ
and then Typ /= Universal_Integer
and then Typ /= Universal_Real
and then Present (It.Abstract_Op)
then
goto Continue;
end if;
-- First matching interpretation -- First matching interpretation
if not Found then if not Found then
...@@ -1818,7 +1866,7 @@ package body Sem_Res is ...@@ -1818,7 +1866,7 @@ package body Sem_Res is
end loop; end loop;
end; end;
elsif Nkind (N) in N_Binary_Op elsif Nkind (N) in N_Binary_Op
and then (Etype (Left_Opnd (N)) = Any_Type and then (Etype (Left_Opnd (N)) = Any_Type
or else Etype (Right_Opnd (N)) = Any_Type) or else Etype (Right_Opnd (N)) = Any_Type)
then then
...@@ -1913,8 +1961,21 @@ package body Sem_Res is ...@@ -1913,8 +1961,21 @@ package body Sem_Res is
and then Scope (It.Nam) = Standard_Standard and then Scope (It.Nam) = Standard_Standard
and then Present (Err_Type) and then Present (Err_Type)
then then
Error_Msg_N -- Special-case the message for universal_fixed
("\\possible interpretation (predefined)#!", N); -- operators, which are not declared with the type
-- of the operand, but appear forever in Standard.
if It.Typ = Universal_Fixed
and then Scope (It.Nam) = Standard_Standard
then
Error_Msg_N
("\\possible interpretation as " &
"universal_fixed operation " &
"(RM 4.5.5 (19))", N);
else
Error_Msg_N
("\\possible interpretation (predefined)#!", N);
end if;
elsif elsif
Nkind (Parent (It.Nam)) = N_Full_Type_Declaration Nkind (Parent (It.Nam)) = N_Full_Type_Declaration
...@@ -1985,6 +2046,8 @@ package body Sem_Res is ...@@ -1985,6 +2046,8 @@ package body Sem_Res is
end if; end if;
<<Continue>>
-- Move to next interpretation -- Move to next interpretation
exit Interp_Loop when No (It.Typ); exit Interp_Loop when No (It.Typ);
...@@ -2190,11 +2253,13 @@ package body Sem_Res is ...@@ -2190,11 +2253,13 @@ package body Sem_Res is
Get_First_Interp (Name (N), Index, It); Get_First_Interp (Name (N), Index, It);
while Present (It.Nam) loop while Present (It.Nam) loop
Error_Msg_Sloc := Sloc (It.Nam); Error_Msg_Sloc := Sloc (It.Nam);
Error_Msg_Node_2 := It.Typ; Error_Msg_Node_2 := It.Nam;
Error_Msg_NE ("\& declared#, type&", N, It.Nam); Error_Msg_NE
("\\ type& for & declared#", N, It.Typ);
Get_Next_Interp (Index, It); Get_Next_Interp (Index, It);
end loop; end loop;
end; end;
else else
Error_Msg_N ("\use -gnatf for details", N); Error_Msg_N ("\use -gnatf for details", N);
end if; end if;
...@@ -2534,7 +2599,7 @@ package body Sem_Res is ...@@ -2534,7 +2599,7 @@ package body Sem_Res is
if not Is_Aliased_View (Act) then if not Is_Aliased_View (Act) then
Error_Msg_NE Error_Msg_NE
("object in prefixed call to& must be aliased" ("object in prefixed call to& must be aliased"
& " ('R'M'-2005 4.3.1 (13))", & " (RM-2005 4.3.1 (13))",
Prefix (Act), Nam); Prefix (Act), Nam);
end if; end if;
...@@ -3012,11 +3077,11 @@ package body Sem_Res is ...@@ -3012,11 +3077,11 @@ package body Sem_Res is
if Ada_Version >= Ada_05 if Ada_Version >= Ada_05
and then Is_Access_Type (F_Typ) and then Is_Access_Type (F_Typ)
and then Can_Never_Be_Null (F_Typ) and then Can_Never_Be_Null (F_Typ)
and then Nkind (A) = N_Null and then Known_Null (A)
then then
Apply_Compile_Time_Constraint_Error Apply_Compile_Time_Constraint_Error
(N => A, (N => A,
Msg => "(Ada 2005) NULL not allowed in " Msg => "(Ada 2005) null not allowed in "
& "null-excluding formal?", & "null-excluding formal?",
Reason => CE_Null_Not_Allowed); Reason => CE_Null_Not_Allowed);
end if; end if;
...@@ -3127,6 +3192,7 @@ package body Sem_Res is ...@@ -3127,6 +3192,7 @@ package body Sem_Res is
elsif Is_Access_Type (A_Typ) elsif Is_Access_Type (A_Typ)
and then Is_Access_Type (F_Typ) and then Is_Access_Type (F_Typ)
and then Ekind (F_Typ) /= E_Access_Subprogram_Type and then Ekind (F_Typ) /= E_Access_Subprogram_Type
and then Ekind (F_Typ) /= E_Anonymous_Access_Subprogram_Type
and then (Is_Class_Wide_Type (Designated_Type (A_Typ)) and then (Is_Class_Wide_Type (Designated_Type (A_Typ))
or else (Nkind (A) = N_Attribute_Reference or else (Nkind (A) = N_Attribute_Reference
and then and then
...@@ -3634,8 +3700,8 @@ package body Sem_Res is ...@@ -3634,8 +3700,8 @@ package body Sem_Res is
declare declare
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
begin begin
Error_Msg_N ("?allocation from empty storage pool", N); Error_Msg_N ("?allocation from empty storage pool!", N);
Error_Msg_N ("\?Storage_Error will be raised at run time", N); Error_Msg_N ("\?Storage_Error will be raised at run time!", N);
Insert_Action (N, Insert_Action (N,
Make_Raise_Storage_Error (Loc, Make_Raise_Storage_Error (Loc,
Reason => SE_Empty_Storage_Pool)); Reason => SE_Empty_Storage_Pool));
...@@ -3659,26 +3725,32 @@ package body Sem_Res is ...@@ -3659,26 +3725,32 @@ package body Sem_Res is
if Nkind (N) = N_Allocator then if Nkind (N) = N_Allocator then
-- An anonymous access discriminant is the definition of a -- An anonymous access discriminant is the definition of a
-- coextension -- coextension.
if Ekind (Typ) = E_Anonymous_Access_Type if Ekind (Typ) = E_Anonymous_Access_Type
and then Nkind (Associated_Node_For_Itype (Typ)) = and then Nkind (Associated_Node_For_Itype (Typ)) =
N_Discriminant_Specification N_Discriminant_Specification
then then
-- Avoid marking an allocator as a dynamic coextension if it is -- Avoid marking an allocator as a dynamic coextension if it is
-- withing a static construct. -- within a static construct.
if not Is_Static_Coextension (N) then if not Is_Static_Coextension (N) then
Set_Is_Coextension (N); Set_Is_Dynamic_Coextension (N);
end if; end if;
-- Cleanup for potential static coextensions -- Cleanup for potential static coextensions
else else
Set_Is_Static_Coextension (N, False); Set_Is_Dynamic_Coextension (N, False);
Set_Is_Static_Coextension (N, False);
end if; end if;
Propagate_Coextensions (N); -- There is no need to propagate any nested coextensions if they
-- are marked as static since they will be rewritten on the spot.
if not Is_Static_Coextension (N) then
Propagate_Coextensions (N);
end if;
end if; end if;
end Resolve_Allocator; end Resolve_Allocator;
...@@ -4269,7 +4341,7 @@ package body Sem_Res is ...@@ -4269,7 +4341,7 @@ package body Sem_Res is
then then
Rtype := Etype (N); Rtype := Etype (N);
Error_Msg_NE Error_Msg_NE
("& should not be used in entry body ('R'M C.7(17))?", ("?& should not be used in entry body (RM C.7(17))",
N, Nam); N, Nam);
Error_Msg_NE Error_Msg_NE
("\Program_Error will be raised at run time?", N, Nam); ("\Program_Error will be raised at run time?", N, Nam);
...@@ -4535,9 +4607,9 @@ package body Sem_Res is ...@@ -4535,9 +4607,9 @@ package body Sem_Res is
Set_Has_Recursive_Call (Nam); Set_Has_Recursive_Call (Nam);
Error_Msg_N Error_Msg_N
("possible infinite recursion?", N); ("?possible infinite recursion!", N);
Error_Msg_N Error_Msg_N
("\Storage_Error may be raised at run time?", N); ("\?Storage_Error may be raised at run time!", N);
end if; end if;
exit Scope_Loop; exit Scope_Loop;
...@@ -5485,10 +5557,8 @@ package body Sem_Res is ...@@ -5485,10 +5557,8 @@ package body Sem_Res is
begin begin
if Ekind (Etype (R)) = E_Allocator_Type then if Ekind (Etype (R)) = E_Allocator_Type then
Acc := Designated_Type (Etype (R)); Acc := Designated_Type (Etype (R));
elsif Ekind (Etype (L)) = E_Allocator_Type then elsif Ekind (Etype (L)) = E_Allocator_Type then
Acc := Designated_Type (Etype (L)); Acc := Designated_Type (Etype (L));
else else
return Empty; return Empty;
end if; end if;
...@@ -5568,7 +5638,7 @@ package body Sem_Res is ...@@ -5568,7 +5638,7 @@ package body Sem_Res is
and then Entity (R) = Standard_True and then Entity (R) = Standard_True
and then Comes_From_Source (R) and then Comes_From_Source (R)
then then
Error_Msg_N ("comparison with True is redundant?", R); Error_Msg_N ("?comparison with True is redundant!", R);
end if; end if;
Check_Unset_Reference (L); Check_Unset_Reference (L);
...@@ -6462,7 +6532,7 @@ package body Sem_Res is ...@@ -6462,7 +6532,7 @@ package body Sem_Res is
and then not Is_Boolean_Type (Typ) and then not Is_Boolean_Type (Typ)
and then Parent_Is_Boolean and then Parent_Is_Boolean
then then
Error_Msg_N ("?not expression should be parenthesized here", N); Error_Msg_N ("?not expression should be parenthesized here!", N);
end if; end if;
Resolve (Right_Opnd (N), B_Typ); Resolve (Right_Opnd (N), B_Typ);
...@@ -6627,7 +6697,7 @@ package body Sem_Res is ...@@ -6627,7 +6697,7 @@ package body Sem_Res is
and then Warn_On_Bad_Fixed_Value and then Warn_On_Bad_Fixed_Value
then then
Error_Msg_N Error_Msg_N
("static fixed-point value is not a multiple of Small?", ("?static fixed-point value is not a multiple of Small!",
N); N);
end if; end if;
...@@ -6992,6 +7062,23 @@ package body Sem_Res is ...@@ -6992,6 +7062,23 @@ package body Sem_Res is
and then not Is_Constrained (Etype (Name))) and then not Is_Constrained (Etype (Name)))
then then
Array_Type := Get_Actual_Subtype (Name); Array_Type := Get_Actual_Subtype (Name);
-- If the name is a selected component that depends on discriminants,
-- build an actual subtype for it. This can happen only when the name
-- itself is overloaded; otherwise the actual subtype is created when
-- the selected component is analyzed.
elsif Nkind (Name) = N_Selected_Component
and then Full_Analysis
and then Depends_On_Discriminant (First_Index (Array_Type))
then
declare
Act_Decl : constant Node_Id :=
Build_Actual_Subtype_Of_Component (Array_Type, Name);
begin
Insert_Action (N, Act_Decl);
Array_Type := Defining_Identifier (Act_Decl);
end;
end if; end if;
-- If name was overloaded, set slice type correctly now -- If name was overloaded, set slice type correctly now
...@@ -7368,11 +7455,11 @@ package body Sem_Res is ...@@ -7368,11 +7455,11 @@ package body Sem_Res is
and then abs (Realval (Rop)) < Delta_Value (Standard_Duration) and then abs (Realval (Rop)) < Delta_Value (Standard_Duration)
then then
Error_Msg_N Error_Msg_N
("universal real operand can only " & ("?universal real operand can only " &
"be interpreted as Duration?", "be interpreted as Duration!",
Rop); Rop);
Error_Msg_N Error_Msg_N
("\precision will be lost in the conversion", Rop); ("\?precision will be lost in the conversion!", Rop);
end if; end if;
elsif Is_Numeric_Type (Typ) elsif Is_Numeric_Type (Typ)
...@@ -7452,7 +7539,7 @@ package body Sem_Res is ...@@ -7452,7 +7539,7 @@ package body Sem_Res is
and then Etype (Entity (Orig_N)) = Orig_T and then Etype (Entity (Orig_N)) = Orig_T
then then
Error_Msg_NE Error_Msg_NE
("?useless conversion, & has this type", N, Entity (Orig_N)); ("?useless conversion, & has this type!", N, Entity (Orig_N));
end if; end if;
end if; end if;
...@@ -7494,7 +7581,11 @@ package body Sem_Res is ...@@ -7494,7 +7581,11 @@ package body Sem_Res is
("type conversions require visibility of the full view", ("type conversions require visibility of the full view",
N); N);
elsif From_With_Type (Target) then elsif From_With_Type (Target)
and then not
(Is_Access_Type (Target_Typ)
and then Present (Non_Limited_View (Etype (Target))))
then
Error_Msg_Qual_Level := 99; Error_Msg_Qual_Level := 99;
Error_Msg_NE ("missing with-clause on package &", N, Error_Msg_NE ("missing with-clause on package &", N,
Cunit_Entity (Get_Source_Unit (Base_Type (Target)))); Cunit_Entity (Get_Source_Unit (Base_Type (Target))));
...@@ -7735,7 +7826,7 @@ package body Sem_Res is ...@@ -7735,7 +7826,7 @@ package body Sem_Res is
-- If we fall through warning should be issued -- If we fall through warning should be issued
Error_Msg_N Error_Msg_N
("?unary minus expression should be parenthesized here", N); ("?unary minus expression should be parenthesized here!", N);
end if; end if;
end if; end if;
end; end;
...@@ -8161,10 +8252,10 @@ package body Sem_Res is ...@@ -8161,10 +8252,10 @@ package body Sem_Res is
end loop; end loop;
if Nkind (N) = N_Real_Literal then if Nkind (N) = N_Real_Literal then
Error_Msg_NE ("real literal interpreted as }?", N, T1); Error_Msg_NE ("?real literal interpreted as }!", N, T1);
else else
Error_Msg_NE ("universal_fixed expression interpreted as }?", N, T1); Error_Msg_NE ("?universal_fixed expression interpreted as }!", N, T1);
end if; end if;
return T1; return T1;
...@@ -8803,7 +8894,7 @@ package body Sem_Res is ...@@ -8803,7 +8894,7 @@ package body Sem_Res is
Operand); Operand);
Error_Msg_N Error_Msg_N
("\value has deeper accessibility than any master " & ("\value has deeper accessibility than any master " &
"('R'M 3.10.2 (13))", "(RM 3.10.2 (13))",
Operand); Operand);
if Is_Entity_Name (Operand) if Is_Entity_Name (Operand)
...@@ -8884,11 +8975,13 @@ package body Sem_Res is ...@@ -8884,11 +8975,13 @@ package body Sem_Res is
elsif Root_Type (Target_Type) = Root_Type (Opnd_Type) then elsif Root_Type (Target_Type) = Root_Type (Opnd_Type) then
return True; return True;
-- In an instance, there may be inconsistent views of the same -- In an instance or an inlined body, there may be inconsistent
-- type, or types derived from the same type. -- views of the same type, or of types derived from a common root.
elsif In_Instance elsif (In_Instance or In_Inlined_Body)
and then Underlying_Type (Target_Type) = Underlying_Type (Opnd_Type) and then
Root_Type (Underlying_Type (Target_Type)) =
Root_Type (Underlying_Type (Opnd_Type))
then then
return True; return True;
......
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