parent
b29ee02b34
commit
6a76d2166c
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
Loading…
Reference in New Issue