Add new tests.

From-SVN: r127853
This commit is contained in:
Arnaud Charlet 2007-08-28 11:34:54 +02:00
parent b29ee02b34
commit 6a76d2166c
8 changed files with 204 additions and 0 deletions

View File

@ -0,0 +1,31 @@
-- { dg-do compile }
package body prefix2 is
procedure Positionne (Objet : in out Instance; X, Y : Coordonnee) is
begin
Objet.X := X;
Objet.Y := Y;
end Positionne;
function RetourneX (Objet : in Instance) return Coordonnee is
begin
return Objet.X;
end RetourneX;
function RetourneY (Objet : in Instance) return Coordonnee is
begin
return Objet.Y;
end RetourneY;
procedure Affiche (Objet : in Class; EstVisible : Boolean) is
begin
if EstVisible then
Objet.Allume;
else
Objet.Eteins;
end if;
end Affiche;
procedure Deplace (Objet : in out Class; DX, DY : Coordonnee) is
begin
Objet.Affiche (False); -- erreur
Objet.Positionne (Objet.X + DX, Objet.Y + DY);
Objet.Affiche (True); -- erreur
end Deplace;
end prefix2;

View File

@ -0,0 +1,17 @@
package prefix2 is
type Coordonnee is range -100 .. 100;
type Instance is abstract tagged private;
subtype Class is Instance'Class;
procedure Positionne (Objet : in out Instance; X, Y : Coordonnee);
function RetourneX (Objet : in Instance) return Coordonnee;
function RetourneY (Objet : in Instance) return Coordonnee;
procedure Allume (Objet : in Instance) is abstract;
procedure Eteins (Objet : in Instance) is abstract;
procedure Affiche (Objet : in Class; EstVisible : Boolean);
procedure Deplace (Objet : in out Class; DX, DY : Coordonnee);
private
type Instance is abstract tagged record
X, Y : Coordonnee := 0;
end record;
end;

View File

@ -0,0 +1,26 @@
-- { dg-do compile }
-- { dg-options "-gnatws" }
package body remote_type is
procedure Append
(Container : in out List;
New_Item : in Element_Type)
is
begin
null;
end Append;
procedure Read
(S : access Root_Stream_Type'Class;
L : out List)
is
begin
null;
end Read;
procedure Write
(S : access Root_Stream_Type'Class;
L : in List)
is
begin
null;
end Write;
end remote_type;

View File

@ -0,0 +1,24 @@
with Ada.Streams;
generic
type Element_Type is private;
package remote_type is
pragma Remote_Types;
type List is private;
procedure Append
(Container : in out List;
New_Item : in Element_Type);
private
use Ada.Streams;
type List_Record is record
A : Boolean;
end record;
type List is access List_Record;
procedure Read
(S : access Root_Stream_Type'Class;
L : out List);
for List'Read use Read;
procedure Write
(S : access Root_Stream_Type'Class;
L : in List);
for List'Write use Write;
end remote_type;

View File

@ -0,0 +1,23 @@
-- { dg-do compile }
with Ada.Finalization; use Ada;
package ai_116 is
pragma Preelaborate;
type Buffer_Type is limited interface;
type Handle is new Finalization.Limited_Controlled and Buffer_Type with
private;
pragma Preelaborable_Initialization(Handle);
type Ptr is access all String;
Null_Handle : constant Handle;
private
type Handle is new Finalization.Limited_Controlled and Buffer_Type with
record
Data : Ptr := null;
end record;
Null_Handle : constant Handle :=
(Finalization.Limited_Controlled with Data => null);
end ai_116;

View File

@ -0,0 +1,16 @@
-- { dg-do compile }
private with Ada.Containers.Ordered_Maps;
with Ada.Containers.Ordered_Sets;
with Ada.Unchecked_Deallocation;
package private_with is
type String_Access is access String;
package Index_Sets is new Ada.Containers.Ordered_Sets
(Element_Type => Positive);
procedure Free is new Ada.Unchecked_Deallocation
(Object => String,
Name => String_Access);
end;

View File

@ -0,0 +1,27 @@
-- { dg-do compile }
pragma Warnings (Off);
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Containers.Hashed_Maps;
with Ada.Containers.Hashed_Sets;
with Ada.Containers.Indefinite_Doubly_Linked_Lists;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Containers.Indefinite_Hashed_Sets;
with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Containers.Indefinite_Ordered_Multisets;
with Ada.Containers.Indefinite_Ordered_Sets;
with Ada.Containers.Indefinite_Vectors;
with Ada.Containers.Ordered_Maps;
with Ada.Containers.Ordered_Multisets;
with Ada.Containers.Ordered_Sets;
with Ada.Containers.Prime_Numbers;
with Ada.Containers.Red_Black_Trees.Generic_Keys;
with Ada.Containers.Red_Black_Trees.Generic_Operations;
with Ada.Containers.Red_Black_Trees.Generic_Set_Operations;
with Ada.Containers.Red_Black_Trees;
with Ada.Containers.Restricted_Doubly_Linked_Lists;
with Ada.Containers.Vectors;
package With_Containers is
pragma Remote_Types;
end With_Containers;

View File

@ -0,0 +1,40 @@
-- { dg-do run }
with GNAT.Table;
with Ada.Text_IO; use Ada.Text_IO;
procedure test_table1 is
type Rec is record
A, B, C, D, E : Integer := 0;
F, G, H, I, J : Integer := 1;
K, L, M, N, O : Integer := 2;
end record;
R : Rec;
package Tab is new GNAT.Table (Rec, Positive, 1, 4, 30);
Last : Natural;
begin
R.O := 3;
Tab.Append (R);
for J in 1 .. 1_000_000 loop
Last := Tab.Last;
begin
Tab.Append (Tab.Table (Last));
exception
when others =>
Put_Line ("exception raise for J =" & J'Img);
raise;
end;
if Tab.Table (Tab.Last) /= R then
Put_Line ("Last is not what is expected");
Put_Line (J'Img);
return;
end if;
end loop;
end;