[Ada] Crash on conversion to derived private type with invisible discriminants

[Arnaud Charlet]

This change fixes the processing of a type conversion to a derived
type with a private non-discriminated ancestor whose full view has a
discriminant with default. Previous compiler versions would crash or produce
a junk error message.

The following compilation must be accepted quietly:
$ gcc -c der.adb

package Pvt is
   type T is private;
private
   type T (D : Integer := 0) is null record;
end Pvt;
with Pvt;
package Der is
   type DT is new Pvt.T;
   function F (X : Pvt.T) return DT;
end Der;
package body Der is
   function F (X : Pvt.T) return DT is
   begin
      return DT (X);
   end F;
end Der;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-29  Thomas Quinot  <quinot@adacore.com>

	* checks.adb (Apply_Type_Conversion_Checks): Use the Underlying_Type of
	the operand type.

-------------- next part --------------
Index: checks.adb
===================================================================
--- checks.adb	(revision 178155)
+++ checks.adb	(working copy)
@@ -1545,7 +1545,7 @@
    --          Lo_OK be True.
    --      (3) If I'Last < 0, then let Hi be F'Succ (I'Last) and let Hi_OK
    --          be False. Otherwise let Hi be F'Pred (I'Last + 1) and let
-   --          Hi_OK be False
+   --          Hi_OK be True.
 
    procedure Apply_Float_Conversion_Check
      (Ck_Node    : Node_Id;
@@ -2325,7 +2325,10 @@
       Target_Type : constant Entity_Id := Etype (N);
       Target_Base : constant Entity_Id := Base_Type (Target_Type);
       Expr        : constant Node_Id   := Expression (N);
-      Expr_Type   : constant Entity_Id := Etype (Expr);
+      Expr_Type   : constant Entity_Id := Underlying_Type (Etype (Expr));
+      --  Note: if Etype (Expr) is a private type without discriminants, its
+      --  full view might have discriminants with defaults, so we need the
+      --  full view here to retrieve the constraints.
 
    begin
       if Inside_A_Generic then
@@ -2383,7 +2386,7 @@
         and then not Is_Constrained (Target_Type)
         and then Present (Stored_Constraint (Target_Type))
       then
-         --  An unconstrained derived type may have inherited discriminant
+         --  An unconstrained derived type may have inherited discriminant.
          --  Build an actual discriminant constraint list using the stored
          --  constraint, to verify that the expression of the parent type
          --  satisfies the constraints imposed by the (unconstrained!)