From 95b42490a89f98ef0b41b9445f71fcefab4ed4a7 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 20 May 2008 14:02:20 +0000 Subject: gen_disp.ad[sb]: New test. * gnat.dg/gen_disp.ad[sb]: New test. * gnat.dg/specs/empty_variants.ads: Adjust. From-SVN: r135658 --- gcc/testsuite/ChangeLog | 2 ++ gcc/testsuite/gnat.dg/gen_disp.adb | 45 ++++++++++++++++++++++++++ gcc/testsuite/gnat.dg/gen_disp.ads | 10 ++++++ gcc/testsuite/gnat.dg/specs/empty_variants.ads | 32 ++++++++++++++++++ 4 files changed, 89 insertions(+) create mode 100644 gcc/testsuite/gnat.dg/gen_disp.adb create mode 100644 gcc/testsuite/gnat.dg/gen_disp.ads create mode 100644 gcc/testsuite/gnat.dg/specs/empty_variants.ads diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 22155ec..d26eee1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -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 diff --git a/gcc/testsuite/gnat.dg/gen_disp.adb b/gcc/testsuite/gnat.dg/gen_disp.adb new file mode 100644 index 0000000..736b9cd --- /dev/null +++ b/gcc/testsuite/gnat.dg/gen_disp.adb @@ -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; diff --git a/gcc/testsuite/gnat.dg/gen_disp.ads b/gcc/testsuite/gnat.dg/gen_disp.ads new file mode 100644 index 0000000..722c0c1 --- /dev/null +++ b/gcc/testsuite/gnat.dg/gen_disp.ads @@ -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; diff --git a/gcc/testsuite/gnat.dg/specs/empty_variants.ads b/gcc/testsuite/gnat.dg/specs/empty_variants.ads new file mode 100644 index 0000000..079b64a --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/empty_variants.ads @@ -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; -- cgit v1.1