sem_eval.adb: Implement d.f flag
2005-11-14 Robert Dewar <dewar@adacore.com> Ed Schonberg <schonberg@adacore.com> * sem_eval.adb: Implement d.f flag (Subtype_Statically_Match): A generic actual type has unknown discriminants when the corresponding actual has a similar partial view. If the routine is called to validate the signature of an inherited operation in a child instance, the generic actual matches the full view, From-SVN: r107004
This commit is contained in:
parent
d4810530b8
commit
0356699b56
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
@ -32,6 +32,7 @@ with Elists; use Elists;
|
|||
with Errout; use Errout;
|
||||
with Eval_Fat; use Eval_Fat;
|
||||
with Exp_Util; use Exp_Util;
|
||||
with Lib; use Lib;
|
||||
with Nmake; use Nmake;
|
||||
with Nlists; use Nlists;
|
||||
with Opt; use Opt;
|
||||
|
@ -4004,11 +4005,21 @@ package body Sem_Eval is
|
|||
return True;
|
||||
|
||||
-- A definite type does not match an indefinite or classwide type
|
||||
-- However, a generic type with unknown discriminants may be
|
||||
-- instantiated with a type with no discriminants, and conformance
|
||||
-- checking on an inherited operation may compare the actual with
|
||||
-- the subtype that renames it in the instance.
|
||||
|
||||
elsif
|
||||
Has_Unknown_Discriminants (T1) /= Has_Unknown_Discriminants (T2)
|
||||
then
|
||||
return False;
|
||||
if Is_Generic_Actual_Type (T1)
|
||||
and then Etype (T1) = T2
|
||||
then
|
||||
return True;
|
||||
else
|
||||
return False;
|
||||
end if;
|
||||
|
||||
-- Array type
|
||||
|
||||
|
@ -4083,13 +4094,17 @@ package body Sem_Eval is
|
|||
is
|
||||
begin
|
||||
Stat := False;
|
||||
Fold := False;
|
||||
|
||||
if Debug_Flag_Dot_F and then In_Extended_Main_Source_Unit (N) then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- If operand is Any_Type, just propagate to result and do not
|
||||
-- try to fold, this prevents cascaded errors.
|
||||
|
||||
if Etype (Op1) = Any_Type then
|
||||
Set_Etype (N, Any_Type);
|
||||
Fold := False;
|
||||
return;
|
||||
|
||||
-- If operand raises constraint error, then replace node N with the
|
||||
|
@ -4099,7 +4114,6 @@ package body Sem_Eval is
|
|||
|
||||
elsif Raises_Constraint_Error (Op1) then
|
||||
Rewrite_In_Raise_CE (N, Op1);
|
||||
Fold := False;
|
||||
return;
|
||||
|
||||
-- If the operand is not static, then the result is not static, and
|
||||
|
@ -4118,7 +4132,6 @@ package body Sem_Eval is
|
|||
and then Is_Generic_Type (Etype (Op1))
|
||||
then
|
||||
Check_Non_Static_Context (Op1);
|
||||
Fold := False;
|
||||
return;
|
||||
|
||||
-- Here we have the case of an operand whose type is OK, which is
|
||||
|
@ -4145,13 +4158,17 @@ package body Sem_Eval is
|
|||
|
||||
begin
|
||||
Stat := False;
|
||||
Fold := False;
|
||||
|
||||
if Debug_Flag_Dot_F and then In_Extended_Main_Source_Unit (N) then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- If either operand is Any_Type, just propagate to result and
|
||||
-- do not try to fold, this prevents cascaded errors.
|
||||
|
||||
if Etype (Op1) = Any_Type or else Etype (Op2) = Any_Type then
|
||||
Set_Etype (N, Any_Type);
|
||||
Fold := False;
|
||||
return;
|
||||
|
||||
-- If left operand raises constraint error, then replace node N with
|
||||
|
@ -4166,7 +4183,6 @@ package body Sem_Eval is
|
|||
|
||||
Rewrite_In_Raise_CE (N, Op1);
|
||||
Set_Is_Static_Expression (N, Rstat);
|
||||
Fold := False;
|
||||
return;
|
||||
|
||||
-- Similar processing for the case of the right operand. Note that
|
||||
|
@ -4180,7 +4196,6 @@ package body Sem_Eval is
|
|||
|
||||
Rewrite_In_Raise_CE (N, Op2);
|
||||
Set_Is_Static_Expression (N, Rstat);
|
||||
Fold := False;
|
||||
return;
|
||||
|
||||
-- Exclude expressions of a generic modular type, as above
|
||||
|
@ -4189,7 +4204,6 @@ package body Sem_Eval is
|
|||
and then Is_Generic_Type (Etype (Op1))
|
||||
then
|
||||
Check_Non_Static_Context (Op1);
|
||||
Fold := False;
|
||||
return;
|
||||
|
||||
-- If result is not static, then check non-static contexts on operands
|
||||
|
|
Loading…
Reference in New Issue