OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

gen_disp.ad[sb]: New test.

Browse Source 
* gnat.dg/gen_disp.ad[sb]: New test.
	* gnat.dg/specs/empty_variants.ads: Adjust.

From-SVN: r135658
This commit is contained in:
Arnaud Charlet 2008-05-20 14:02:20 +00:00 committed by Arnaud Charlet
parent 9c63c208a5
commit 95b42490a8
4 changed files with 89 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gcc/testsuite/ChangeLog
View File

@ -3,7 +3,9 @@
* gnat.dg/testint.adb: New test.
* gnat.dg/modular1.adb: New test.
* gnat.dg/test_iface_aggr.adb: New test.
* gnat.dg/gen_disp.ad[sb]: New test.
* gnat.dg/specs/tag2.ads: Adjust.
* gnat.dg/specs/empty_variants.ads: Adjust.
2008-05-20 Richard Guenther <rguenther@suse.de>

45
gcc/testsuite/gnat.dg/gen_disp.adb Normal file
View File

@ -0,0 +1,45 @@
-- { dg-do compile }
with Ada.Containers.Ordered_Maps;
with Ada.Tags.Generic_Dispatching_Constructor;
package body gen_disp is
use type Ada.Tags.Tag;
function "<" (L, R : in Ada.Tags.Tag) return Boolean is
begin
return Ada.Tags.External_Tag (L) < Ada.Tags.External_Tag (R);
end "<";
package Char_To_Tag_Map is new Ada.Containers.Ordered_Maps (
Key_Type => Character,
Element_Type => Ada.Tags.Tag,
"<" => "<",
"=" => Ada.Tags. "=");
package Tag_To_Char_Map is new Ada.Containers.Ordered_Maps (
Key_Type => Ada.Tags.Tag,
Element_Type => Character,
"<" => "<",
"=" => "=");
use type Char_To_Tag_Map.Cursor;
use type Tag_To_Char_Map.Cursor;
Char_To_Tag : Char_To_Tag_Map.Map;
Tag_To_Char : Tag_To_Char_Map.Map;
function Get_Object is new
Ada.Tags.Generic_Dispatching_Constructor
(Root_Type, Ada.Streams.Root_Stream_Type'Class, Root_Type'Input);
function Root_Type_Class_Input
(S : not null access Ada.Streams.Root_Stream_Type'Class)
return Root_Type'Class
is
External_Tag : constant Character := Character'Input (S);
C : constant Char_To_Tag_Map.Cursor := Char_To_Tag.Find (External_Tag);
begin
return Get_Object (Char_To_Tag_Map.Element (C), S);
end Root_Type_Class_Input;
end gen_disp;

10
gcc/testsuite/gnat.dg/gen_disp.ads Normal file
View File

@ -0,0 +1,10 @@
with Ada.Streams, Ada.Tags;
package gen_disp is
type Root_Type is tagged null record;
function Root_Type_Class_Input
(S : not null access Ada.Streams.Root_Stream_Type'Class)
return Root_Type'Class;
for Root_Type'Class'Input use Root_Type_Class_Input;
end gen_disp;

32
gcc/testsuite/gnat.dg/specs/empty_variants.ads Normal file
View File

@ -0,0 +1,32 @@
-- { dg-do compile }
-- { dg-options "-gnatdF" }
package Empty_Variants is
type Rec (D : Integer := 1) is record
case D is
when 1 =>
I : Integer;
when 2 .. 5 =>
J : Integer;
K : Integer;
when 6 =>
null;
when 7 .. 8 =>
null;
when others =>
L : Integer;
M : Integer;
N : Integer;
end case;
end record;
R : Rec;
I : Integer := R.I;
J : Integer := R.J;
K : Integer := R.K;
L : Integer := R.L;
M : Integer := R.L;
end Empty_Variants;