From 1e00de1fd7f522836d0d7cac410c804b51d783af Mon Sep 17 00:00:00 2001
From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Tue, 8 Apr 2008 09:22:13 +0200
Subject: [PATCH] parent_ltd_with-child_full_view.adb: New test.
* gnat.dg/parent_ltd_with-child_full_view.adb: New test.
* gnat.dg/rt1.adb: New test.
* gnat.dg/test_time_stamp.adb: New test.
* gnat.dg/specs/warn_star.ads: New test.
* gnat.dg/specs/aggr1.ads: New test.
From-SVN: r134085
---
.../parent_ltd_with-child_full_view.adb | 12 ++++++
.../parent_ltd_with-child_full_view.ads | 12 ++++++
gcc/testsuite/gnat.dg/parent_ltd_with.ads | 15 ++++++++
gcc/testsuite/gnat.dg/rt1.adb | 9 +++++
gcc/testsuite/gnat.dg/rt1.ads | 14 +++++++
gcc/testsuite/gnat.dg/specs/aggr1.ads | 8 ++++
gcc/testsuite/gnat.dg/specs/warnstar.ads | 12 ++++++
gcc/testsuite/gnat.dg/test_time_stamp.adb | 37 +++++++++++++++++++
8 files changed, 119 insertions(+)
create mode 100644 gcc/testsuite/gnat.dg/parent_ltd_with-child_full_view.adb
create mode 100644 gcc/testsuite/gnat.dg/parent_ltd_with-child_full_view.ads
create mode 100644 gcc/testsuite/gnat.dg/parent_ltd_with.ads
create mode 100644 gcc/testsuite/gnat.dg/rt1.adb
create mode 100644 gcc/testsuite/gnat.dg/rt1.ads
create mode 100644 gcc/testsuite/gnat.dg/specs/aggr1.ads
create mode 100644 gcc/testsuite/gnat.dg/specs/warnstar.ads
create mode 100644 gcc/testsuite/gnat.dg/test_time_stamp.adb
diff --git a/gcc/testsuite/gnat.dg/parent_ltd_with-child_full_view.adb b/gcc/testsuite/gnat.dg/parent_ltd_with-child_full_view.adb
new file mode 100644
index 000000000000..cd8cf4240d42
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/parent_ltd_with-child_full_view.adb
@@ -0,0 +1,12 @@
+-- { dg-do compile }
+
+package body Parent_Ltd_With.Child_Full_View is
+
+ function New_Child_Symbol return Child_Symbol_Access is
+ Sym : constant Child_Symbol_Access := new Child_Symbol'(Comp => 10);
+
+ begin
+ return Sym;
+ end New_Child_Symbol;
+
+end Parent_Ltd_With.Child_Full_View;
diff --git a/gcc/testsuite/gnat.dg/parent_ltd_with-child_full_view.ads b/gcc/testsuite/gnat.dg/parent_ltd_with-child_full_view.ads
new file mode 100644
index 000000000000..3f7aa2e99fca
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/parent_ltd_with-child_full_view.ads
@@ -0,0 +1,12 @@
+package Parent_Ltd_With.Child_Full_View is
+
+ type Child_Symbol is new Parent_Ltd_With.Symbol with private;
+ type Child_Symbol_Access is access all Child_Symbol;
+
+ function New_Child_Symbol return Child_Symbol_Access;
+
+private
+
+ type Child_Symbol is new Parent_Ltd_With.Symbol with null record;
+
+end Parent_Ltd_With.Child_Full_View;
diff --git a/gcc/testsuite/gnat.dg/parent_ltd_with.ads b/gcc/testsuite/gnat.dg/parent_ltd_with.ads
new file mode 100644
index 000000000000..637aa7c3beb0
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/parent_ltd_with.ads
@@ -0,0 +1,15 @@
+limited with Parent_Ltd_With.Child_Full_View;
+
+package Parent_Ltd_With is
+
+ type Symbol is abstract tagged limited private;
+
+ type Symbol_Access is access all Symbol'Class;
+
+private
+
+ type Symbol is abstract tagged limited record
+ Comp : Integer;
+ end record;
+
+end Parent_Ltd_With;
diff --git a/gcc/testsuite/gnat.dg/rt1.adb b/gcc/testsuite/gnat.dg/rt1.adb
new file mode 100644
index 000000000000..ce94928caca5
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/rt1.adb
@@ -0,0 +1,9 @@
+-- { dg-do compile }
+
+package body RT1 is
+ procedure P (S : access Root_Stream_Type'Class) is
+ Val : constant Ptr := Ptr'Input (S);
+ begin
+ null;
+ end P;
+end RT1;
diff --git a/gcc/testsuite/gnat.dg/rt1.ads b/gcc/testsuite/gnat.dg/rt1.ads
new file mode 100644
index 000000000000..50cbbf0ff74e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/rt1.ads
@@ -0,0 +1,14 @@
+with Ada.Streams; use Ada.Streams;
+package RT1 is
+ pragma Remote_Types;
+
+ type Ptr is private;
+ procedure Read (X : access Root_Stream_Type'Class; V : out Ptr) is null;
+ procedure Write (X : access Root_Stream_Type'Class; V : Ptr) is null;
+ for Ptr'Read use Read;
+ for Ptr'Write use Write;
+
+ procedure P (S : access Root_Stream_Type'Class);
+private
+ type Ptr is not null access all Integer;
+end RT1;
diff --git a/gcc/testsuite/gnat.dg/specs/aggr1.ads b/gcc/testsuite/gnat.dg/specs/aggr1.ads
new file mode 100644
index 000000000000..6c7663513741
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/aggr1.ads
@@ -0,0 +1,8 @@
+-- { dg-do compile }
+
+package aggr1 is
+ type Buffer_Array is array (1 .. 2 ** 23) of Integer;
+ type Message is record
+ Data : Buffer_Array := (others => 0);
+ end record;
+end;
diff --git a/gcc/testsuite/gnat.dg/specs/warnstar.ads b/gcc/testsuite/gnat.dg/specs/warnstar.ads
new file mode 100644
index 000000000000..325cbb6f329e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/warnstar.ads
@@ -0,0 +1,12 @@
+-- { dg-do compile }
+
+pragma Warnings (Off, "*bits of*unused");
+package warnstar is
+ type r is record
+ a : integer;
+ end record;
+
+ for r use record
+ a at 0 range 0 .. 1023;
+ end record;
+end warnstar;
diff --git a/gcc/testsuite/gnat.dg/test_time_stamp.adb b/gcc/testsuite/gnat.dg/test_time_stamp.adb
new file mode 100644
index 000000000000..1e25f8780415
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/test_time_stamp.adb
@@ -0,0 +1,37 @@
+-- { dg-do run }
+
+with GNAT.Time_Stamp;
+use GNAT.Time_Stamp;
+
+procedure test_time_stamp is
+ S : constant String := Current_Time;
+
+ function NN (S : String) return Boolean is
+ begin
+ for J in S'Range loop
+ if S (J) not in '0' .. '9' then
+ return True;
+ end if;
+ end loop;
+ return False;
+ end NN;
+
+begin
+ if S'Length /= 22
+ or else S (5) /= '-'
+ or else S (8) /= '-'
+ or else S (11) /= ' '
+ or else S (14) /= ':'
+ or else S (17) /= ':'
+ or else S (20) /= '.'
+ or else NN (S (1 .. 4))
+ or else NN (S (6 .. 7))
+ or else NN (S (9 .. 10))
+ or else NN (S (12 .. 13))
+ or else NN (S (15 .. 16))
+ or else NN (S (18 .. 19))
+ or else NN (S (21 .. 22))
+ then
+ raise Program_Error;
+ end if;
+end;
--
GitLab