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,

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@107004 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 396027d..d99e042 100644 (file)
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -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