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
This commit is contained in:
Arnaud Charlet 2008-04-08 09:22:13 +02:00
parent ea081ad725
commit 1e00de1fd7
8 changed files with 119 additions and 0 deletions

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;