15 files changed, 328 insertions, 0 deletions
diff --git a/gcc/testsuite/gnat.dg/discr12.adb b/gcc/testsuite/gnat.dg/discr12.adb
new file mode 100644
index 0000000..ae72850
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr12.adb
@@ -0,0 +1,35 @@
+-- { dg-do compile }
+
+with Discr12_Pkg; use Discr12_Pkg;
+
+procedure Discr12 is
+
+  subtype Small_Int is Integer range 1..10;
+
+  package P is
+
+    type PT_W_Disc (D : Small_Int) is private;
+
+    type Rec_W_Private (D1 : Integer) is
+    record
+      C : PT_W_Disc (D1);
+    end record;
+
+    type Rec_01 (D3 : Integer) is
+    record
+      C1 : Rec_W_Private (D3);
+    end record;
+
+    type Arr is array (1 .. 5) of Rec_01(Dummy(0));
+
+  private
+    type PT_W_Disc (D : Small_Int) is 
+    record
+      Str : String (1 .. D);
+    end record;
+
+  end P;
+
+begin
+  Null;
+end;
diff --git a/gcc/testsuite/gnat.dg/discr12_pkg.ads b/gcc/testsuite/gnat.dg/discr12_pkg.ads
new file mode 100644
index 0000000..7851463
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr12_pkg.ads
@@ -0,0 +1,5 @@
+package Discr12_Pkg is
+
+  function Dummy (I : Integer) return Integer;
+
+end Discr12_Pkg;
diff --git a/gcc/testsuite/gnat.dg/discr13.adb b/gcc/testsuite/gnat.dg/discr13.adb
new file mode 100644
index 0000000..3dcf215
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr13.adb
@@ -0,0 +1,30 @@
+-- { dg-do compile }
+
+with Discr12_Pkg; use Discr12_Pkg;
+
+procedure Discr13 is
+
+  function F1 return Integer is
+  begin
+    return Dummy (1);
+  end F1;
+
+  protected type Poe (D3 : Integer := F1) is
+    entry E (D3 .. F1);    -- F1 evaluated
+    function Is_Ok (D3 : Integer; E_First : Integer; E_Last : Integer) return Boolean;
+  end Poe;
+
+  protected body Poe is
+    entry E (for I in D3 .. F1) when True is
+    begin
+      null;
+    end E;
+    function Is_Ok (D3 : Integer; E_First : Integer; E_Last : Integer) return Boolean is
+    begin
+      return False;
+    end Is_Ok;
+  end Poe;
+
+begin
+  null;
+end;
diff --git a/gcc/testsuite/gnat.dg/discr14.adb b/gcc/testsuite/gnat.dg/discr14.adb
new file mode 100644
index 0000000..490ec43
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr14.adb
@@ -0,0 +1,11 @@
+-- { dg-do compile }
+
+package body Discr14 is
+
+   procedure ASSIGN( TARGET : in out SW_TYPE_INFO ;
+                     SOURCE : in     SW_TYPE_INFO ) is
+   begin
+      TARGET := new T_SW_TYPE_DESCRIPTOR( SOURCE.SW_TYPE, SOURCE.DIMENSION );
+   end ASSIGN;
+
+end Discr14;
diff --git a/gcc/testsuite/gnat.dg/discr14.ads b/gcc/testsuite/gnat.dg/discr14.ads
new file mode 100644
index 0000000..a6b5a0a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr14.ads
@@ -0,0 +1,42 @@
+package Discr14 is
+
+  type COMPLETION_CODE is (SUCCESS, FAILURE, NONE);
+
+  type T_SW_TYPE is (NONE, COMPLETION_CODE_TYPE);       
+
+  type T_COMPLETION_CODE_RANGE (CONSTRAINED: BOOLEAN := FALSE) is
+  record
+     case CONSTRAINED is
+        when TRUE =>
+           FIRST  : COMPLETION_CODE := SUCCESS;
+           LAST   : COMPLETION_CODE := FAILURE;
+        when FALSE =>
+           null;
+     end case;
+  end record;
+
+  type T_SW_DIMENSIONS is range 0 .. 3;
+
+  type T_SW_INDEX_LIST is array (T_SW_DIMENSIONS range <>) of POSITIVE;
+
+  type T_SW_TYPE_DESCRIPTOR (SW_TYPE   :  T_SW_TYPE       := NONE;
+                             DIMENSION :  T_SW_DIMENSIONS := 0)  is
+  record
+     BOUNDS : T_SW_INDEX_LIST (1 .. DIMENSION);
+
+     case SW_TYPE is
+
+        when COMPLETION_CODE_TYPE  =>
+           COMPLETION_CODE_RANGE   : T_COMPLETION_CODE_RANGE;
+
+        when OTHERS  =>
+           null;
+
+     end case;
+  end record;
+
+  type SW_TYPE_INFO is access T_SW_TYPE_DESCRIPTOR;
+
+  procedure ASSIGN(TARGET : in out SW_TYPE_INFO; SOURCE : in SW_TYPE_INFO) ;
+
+end Discr14;
diff --git a/gcc/testsuite/gnat.dg/discr15.adb b/gcc/testsuite/gnat.dg/discr15.adb
new file mode 100644
index 0000000..0030ac7d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr15.adb
@@ -0,0 +1,14 @@
+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+with Discr15_Pkg; use Discr15_Pkg;
+
+procedure Discr15 (History : in Rec_Multi_Moment_History) is
+
+  Sub: constant Rec_Multi_Moment_History := Sub_History_Of (History);
+  subtype Vec is String(0..Sub.Last);
+  Mmts : array(1..Sub.Size) of Vec;
+
+begin
+  null;
+end;
diff --git a/gcc/testsuite/gnat.dg/discr15_pkg.ads b/gcc/testsuite/gnat.dg/discr15_pkg.ads
new file mode 100644
index 0000000..1f3bf28
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr15_pkg.ads
@@ -0,0 +1,16 @@
+package Discr15_Pkg is
+
+   type Moment is new Positive;
+
+   type Multi_Moment_History is array (Natural range <>, Moment range <>) of Float;
+
+   type Rec_Multi_Moment_History (Len : Natural; Size : Moment) is
+   record
+      Moments : Multi_Moment_History(0..Len, 1..Size);
+      Last    : Natural;
+   end record;
+
+   function Sub_History_Of (History : Rec_Multi_Moment_History)
+      return Rec_Multi_Moment_History;
+
+end Discr15_Pkg;
diff --git a/gcc/testsuite/gnat.dg/discr16.adb b/gcc/testsuite/gnat.dg/discr16.adb
new file mode 100644
index 0000000..c4c24fd
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr16.adb
@@ -0,0 +1,23 @@
+-- { dg-do compile }
+
+with Discr16_G;
+with Discr16_Cont; use Discr16_Cont;
+
+procedure Discr16 is
+
+  generic
+    type T is (<>);
+  function MAX_ADD_G(X : T; I : INTEGER) return T;
+
+  function MAX_ADD_G(X : T; I : INTEGER) return T is
+  begin
+    return T'val(T'pos(X) + LONG_INTEGER(I));
+  end;
+
+  function MAX_ADD is new MAX_ADD_G(ES6A);
+
+  package P is new Discr16_G(ES6A, MAX_ADD);
+
+begin
+  null;
+end;
diff --git a/gcc/testsuite/gnat.dg/discr16_cont.ads b/gcc/testsuite/gnat.dg/discr16_cont.ads
new file mode 100644
index 0000000..ea041ca
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr16_cont.ads
@@ -0,0 +1,7 @@
+with Discr16_Pkg; use Discr16_Pkg;
+
+package Discr16_Cont is
+
+  type ES6a is new ET3a range E2..E4;
+
+end;
diff --git a/gcc/testsuite/gnat.dg/discr16_g.ads b/gcc/testsuite/gnat.dg/discr16_g.ads
new file mode 100644
index 0000000..f163f75
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr16_g.ads
@@ -0,0 +1,18 @@
+generic
+
+  type T is (<>);
+  with function MAX_ADD(X : T; I : INTEGER) return T;
+
+package Discr16_G is
+
+  LO : T := T'val(T'pos(T'first));
+  HI : T := T'val(T'pos(MAX_ADD(LO, 15)));
+
+  type A2 is array(T range <>) of T;
+
+  type R2(D : T) is
+  record
+    C : A2(LO..D);
+  end record;
+
+end;
diff --git a/gcc/testsuite/gnat.dg/discr16_pkg.ads b/gcc/testsuite/gnat.dg/discr16_pkg.ads
new file mode 100644
index 0000000..985785f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr16_pkg.ads
@@ -0,0 +1,7 @@
+package Discr16_Pkg is
+
+  type ET3a is (E1, E2, E3, E4, E5);
+  for ET3a use (E1=> 32_001, E2=> 32_002, E3=> 32_003,
+                E4=> 32_004, E5=> 32_005);
+
+end;
diff --git a/gcc/testsuite/gnat.dg/discr17.adb b/gcc/testsuite/gnat.dg/discr17.adb
new file mode 100644
index 0000000..d7b480c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr17.adb
@@ -0,0 +1,66 @@
+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+procedure Discr17 is
+
+  F1_Poe : Integer := 18;
+
+  function F1 return Integer is
+  begin
+    F1_Poe := F1_Poe - 1;
+    return F1_Poe;
+ end F1;
+
+  generic
+    type T is limited private;
+    with function Is_Ok (X : T) return Boolean;
+  procedure Check;
+
+  procedure Check is
+  begin
+
+    declare
+      type Poe is new T;
+      X : Poe;
+      Y : Poe;
+    begin
+      null;
+    end;
+
+    declare
+      type Poe is new T;
+      type Arr is array (1 .. 2) of Poe;
+      X : Arr;
+      B : Boolean := Is_Ok (T (X (1)));
+    begin
+      null;
+    end;
+
+ end;
+
+  protected type Poe (D3 : Integer := F1) is
+    entry E (D3 .. F1);    -- F1 evaluated
+    function Is_Ok return Boolean;
+  end Poe;
+
+  protected body Poe is
+    entry E (for I in D3 .. F1) when True is
+    begin
+      null;
+    end E;
+    function Is_Ok return Boolean is
+    begin
+      return False;
+    end Is_Ok;
+  end Poe;
+
+  function Is_Ok (C : Poe) return Boolean is
+  begin
+    return C.Is_Ok;
+  end Is_Ok;
+
+  procedure Chk is new Check (Poe, Is_Ok);
+
+begin
+   Chk;
+end;
diff --git a/gcc/testsuite/gnat.dg/discr18.adb b/gcc/testsuite/gnat.dg/discr18.adb
new file mode 100644
index 0000000..bd3fd79
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr18.adb
@@ -0,0 +1,19 @@
+-- { dg-do compile }
+
+with Discr18_Pkg; use Discr18_Pkg;
+
+procedure Discr18 is
+
+  String_10 : String (1..10) := "1234567890";
+
+  MD : Multiple_Discriminants (A => 10, B => 10) :=
+         Multiple_Discriminants'(A  => 10,
+                                 B  => 10,
+                                 S1 => String_10,
+                                 S2 => String_10);
+  MDE : Multiple_Discriminant_Extension (C => 10) :=
+          (MD with C  => 10, S3 => String_10);
+
+begin
+  Do_Something(MDE);
+end;
diff --git a/gcc/testsuite/gnat.dg/discr18_pkg.ads b/gcc/testsuite/gnat.dg/discr18_pkg.ads
new file mode 100644
index 0000000..72f7fec
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr18_pkg.ads
@@ -0,0 +1,19 @@
+package Discr18_Pkg is
+
+   subtype Length is Natural range 0..256;
+
+   type Multiple_Discriminants (A, B : Length) is tagged
+      record
+         S1 : String (1..A);
+         S2 : String (1..B);
+      end record;
+
+   procedure Do_Something (Rec : in out Multiple_Discriminants);
+
+   type Multiple_Discriminant_Extension (C : Length) is
+      new Multiple_Discriminants (A => C, B => C)
+      with record
+         S3 : String (1..C);
+      end record;
+
+end Discr18_Pkg;
diff --git a/gcc/testsuite/gnat.dg/discr19.adb b/gcc/testsuite/gnat.dg/discr19.adb
new file mode 100644
index 0000000..8f5c56b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr19.adb
@@ -0,0 +1,16 @@
+-- { dg-do compile }
+
+procedure Discr19 is
+
+   type Arr_Int_T is array (Integer range <>) of Integer;
+
+   type Abs_Tag_Rec_T (N : Integer; M : Integer) is abstract tagged record
+      Arr_Int : Arr_Int_T (1..M);
+   end record;
+
+   type Tag_Rec_T (M : Integer)
+     is new Abs_Tag_Rec_T (N => 1, M => M) with null record;
+
+begin
+   null;
+end;