parent_ltd_with-child_full_view.adb: New test.
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 8 Apr 2008 07:22:13 +0000 (09:22 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 8 Apr 2008 07:22:13 +0000 (09:22 +0200)
* 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

gcc/testsuite/gnat.dg/parent_ltd_with-child_full_view.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/parent_ltd_with-child_full_view.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/parent_ltd_with.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/rt1.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/rt1.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/specs/aggr1.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/specs/warnstar.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/test_time_stamp.adb [new file with mode: 0644]

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 (file)
index 0000000..cd8cf42
--- /dev/null
@@ -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 (file)
index 0000000..3f7aa2e
--- /dev/null
@@ -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 (file)
index 0000000..637aa7c
--- /dev/null
@@ -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 (file)
index 0000000..ce94928
--- /dev/null
@@ -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 (file)
index 0000000..50cbbf0
--- /dev/null
@@ -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 (file)
index 0000000..6c76635
--- /dev/null
@@ -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 (file)
index 0000000..325cbb6
--- /dev/null
@@ -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 (file)
index 0000000..1e25f87
--- /dev/null
@@ -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;