From 1e00de1fd7f522836d0d7cac410c804b51d783af Mon Sep 17 00:00:00 2001 From: Arnaud Charlet 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 00000000000..cd8cf4240d4 --- /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 00000000000..3f7aa2e99fc --- /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 00000000000..637aa7c3beb --- /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 00000000000..ce94928caca --- /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 00000000000..50cbbf0ff74 --- /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 00000000000..6c766351374 --- /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 00000000000..325cbb6f329 --- /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 00000000000..1e25f878041 --- /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; -- 2.30.2