From 21d0fa1ef08190fcfe68bd0d00ac3da0ad7afa1b Mon Sep 17 00:00:00 2001
From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Thu, 16 Aug 2007 15:51:43 +0200
Subject: [PATCH] Add new tests.
From-SVN: r127555
---
gcc/testsuite/gnat.dg/deref1.ads | 4 +++
gcc/testsuite/gnat.dg/deref2.ads | 13 ++++++++++
gcc/testsuite/gnat.dg/deref3.adb | 10 ++++++++
gcc/testsuite/gnat.dg/discr_test.adb | 31 ++++++++++++++++++++++++
gcc/testsuite/gnat.dg/elim1.adb | 6 +++++
gcc/testsuite/gnat.dg/elim1.ads | 5 ++++
gcc/testsuite/gnat.dg/elim2.adb | 7 ++++++
gcc/testsuite/gnat.dg/specs/limited1.ads | 12 +++++++++
8 files changed, 88 insertions(+)
create mode 100644 gcc/testsuite/gnat.dg/deref1.ads
create mode 100644 gcc/testsuite/gnat.dg/deref2.ads
create mode 100644 gcc/testsuite/gnat.dg/deref3.adb
create mode 100644 gcc/testsuite/gnat.dg/discr_test.adb
create mode 100644 gcc/testsuite/gnat.dg/elim1.adb
create mode 100644 gcc/testsuite/gnat.dg/elim1.ads
create mode 100644 gcc/testsuite/gnat.dg/elim2.adb
create mode 100644 gcc/testsuite/gnat.dg/specs/limited1.ads
diff --git a/gcc/testsuite/gnat.dg/deref1.ads b/gcc/testsuite/gnat.dg/deref1.ads
new file mode 100644
index 000000000000..3da99ab0ae57
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deref1.ads
@@ -0,0 +1,4 @@
+package deref1 is
+ type T is tagged limited null record;
+ procedure Op (Obj : in out T);
+end deref1;
diff --git a/gcc/testsuite/gnat.dg/deref2.ads b/gcc/testsuite/gnat.dg/deref2.ads
new file mode 100644
index 000000000000..84d509f91510
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deref2.ads
@@ -0,0 +1,13 @@
+with deref1;
+package deref2 is
+ type NT is tagged limited private;
+
+ function PT_View (Obj : not null access NT)
+ return not null access deref1.T'Class;
+private
+ type PT (Obj : not null access NT) is new deref1.T with null record;
+
+ type NT is tagged limited record
+ PT_View : aliased PT (NT'Access);
+ end record;
+end;
diff --git a/gcc/testsuite/gnat.dg/deref3.adb b/gcc/testsuite/gnat.dg/deref3.adb
new file mode 100644
index 000000000000..b0edb18fb52c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deref3.adb
@@ -0,0 +1,10 @@
+-- { dg-do compile }
+
+with deref2;
+procedure deref3 is
+ Obj : aliased deref2.NT;
+begin
+ deref2.PT_View (Obj'Access).Op;
+ Obj.PT_View.all.Op;
+ Obj.PT_View.Op;
+end;
diff --git a/gcc/testsuite/gnat.dg/discr_test.adb b/gcc/testsuite/gnat.dg/discr_test.adb
new file mode 100644
index 000000000000..1a6a4d21d8db
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr_test.adb
@@ -0,0 +1,31 @@
+-- { dg-do compile }
+
+procedure Discr_Test is
+ procedure P is begin null; end P;
+
+ task type Tsk1 is
+ entry rvT;
+ end Tsk1;
+
+ task body Tsk1 is
+ begin
+ accept rvT;
+ end Tsk1;
+
+ task type Tsk2 (pS : not null access procedure) is
+ entry rvT;
+ end Tsk2;
+
+ task body Tsk2 is
+ tskT : Tsk1;
+ begin
+ accept rvT do
+ requeue tskT.rvT;
+ end rvT;
+ pS.all;
+ end;
+
+ Obj : Tsk2 (P'access);
+begin
+ Obj.rvT;
+end;
diff --git a/gcc/testsuite/gnat.dg/elim1.adb b/gcc/testsuite/gnat.dg/elim1.adb
new file mode 100644
index 000000000000..7d2ddd193d9e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/elim1.adb
@@ -0,0 +1,6 @@
+package body elim1 is
+ procedure d (a : t) is
+ begin
+ null;
+ end;
+end;
diff --git a/gcc/testsuite/gnat.dg/elim1.ads b/gcc/testsuite/gnat.dg/elim1.ads
new file mode 100644
index 000000000000..7a7bd3588b48
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/elim1.ads
@@ -0,0 +1,5 @@
+pragma Eliminate (p, d);
+package elim1 is
+ type t is tagged null record;
+ procedure d (a : t);
+end;
diff --git a/gcc/testsuite/gnat.dg/elim2.adb b/gcc/testsuite/gnat.dg/elim2.adb
new file mode 100644
index 000000000000..a816f0890301
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/elim2.adb
@@ -0,0 +1,7 @@
+-- { dg-do run }
+
+with elim1;
+procedure elim2 is
+begin
+ null;
+end;
diff --git a/gcc/testsuite/gnat.dg/specs/limited1.ads b/gcc/testsuite/gnat.dg/specs/limited1.ads
new file mode 100644
index 000000000000..268eb227a320
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/limited1.ads
@@ -0,0 +1,12 @@
+-- { dg-do compile }
+
+package limited1 is
+ pragma Pure;
+
+ type Buffer is limited interface;
+ type Synchronous_Buffer_Type is synchronized interface and Buffer;
+ type Client_Buffer_Type is new Synchronous_Buffer_Type with private;
+
+private
+ type Client_Buffer_Type is new Synchronous_Buffer_Type with null record;
+end limited1;
--
GitLab