mirror of git://gcc.gnu.org/git/gcc.git
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:
parent
ea081ad725
commit
1e00de1fd7
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
Loading…
Reference in New Issue