summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/cxa/cxa4012.a
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/ada/acats/tests/cxa/cxa4012.a
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxa/cxa4012.a')
-rw-r--r--gcc/testsuite/ada/acats/tests/cxa/cxa4012.a305
1 files changed, 305 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4012.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4012.a
new file mode 100644
index 000000000..5ab12b6df
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/cxa/cxa4012.a
@@ -0,0 +1,305 @@
+-- CXA4012.A
+--
+-- Grant of Unlimited Rights
+--
+-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
+-- unlimited rights in the software and documentation contained herein.
+-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
+-- this public release, the Government intends to confer upon all
+-- recipients unlimited rights equal to those held by the Government.
+-- These rights include rights to use, duplicate, release or disclose the
+-- released technical data and computer software in whole or in part, in
+-- any manner and for any purpose whatsoever, and to have or permit others
+-- to do so.
+--
+-- DISCLAIMER
+--
+-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+-- PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+-- Check that the types, operations, and other entities defined within
+-- the package Ada.Strings.Wide_Maps are available and produce correct
+-- results.
+--
+-- TEST DESCRIPTION:
+-- This test demonstrates the availability and function of the types and
+-- operations defined in package Ada.Strings.Wide_Maps. It demonstrates
+-- the use of these types and functions as they would be used in common
+-- programming practice.
+-- Wide_Character set creation, assignment, and comparison are evaluated
+-- in this test. Each of the functions provided in package
+-- Ada.Strings.Wide_Maps is utilized in creating or manipulating set
+-- objects, and the function results are evaluated for correctness.
+-- Wide_Character sequences are examined using the functions provided for
+-- manipulating objects of this type. Likewise, Wide_Character maps are
+-- created, and their contents evaluated. Exception raising conditions
+-- from the function To_Mapping are also created.
+-- Note: Throughout this test, the set logical operators are printed in
+-- capital letters to enhance their visibility.
+--
+--
+-- CHANGE HISTORY:
+-- 06 Dec 94 SAIC ACVC 2.0
+-- 01 Nov 95 SAIC Update and repair for ACVC 2.0.1.
+--
+--!
+
+with Ada.Characters.Handling;
+with Ada.Strings.Wide_Maps;
+
+package CXA40120 is
+
+ function Equiv (Ch : Character) return Wide_Character;
+ function Equiv (Str : String)
+ return Ada.Strings.Wide_Maps.Wide_Character_Sequence;
+ function X_Map(From : Wide_Character) return Wide_Character;
+
+end CXA40120;
+
+package body CXA40120 is
+
+ -- The following two functions are used to translate character and string
+ -- values to "Wide" values. They will be applied to certain Wide_Map
+ -- subprogram parameters to simulate the use of Wide_Characters and
+ -- Wide_Character_Sequences in actual practice.
+ -- Note: These functions do not actually return "equivalent" wide
+ -- characters to their character inputs, just "non-character"
+ -- wide characters.
+
+ function Equiv (Ch : Character) return Wide_Character is
+ C : Character := Ch;
+ begin
+ if Ch = ' ' then
+ return Ada.Characters.Handling.To_Wide_Character(C);
+ else
+ return Wide_Character'Val(Character'Pos(Ch) +
+ Character'Pos(Character'Last) + 1);
+ end if;
+ end Equiv;
+
+ function Equiv (Str : String)
+ return Ada.Strings.Wide_Maps.Wide_Character_Sequence is
+ use Ada.Strings;
+ WS : Wide_Maps.Wide_Character_Sequence(Str'First..Str'Last);
+ begin
+ for i in Str'First..Str'Last loop
+ WS(i) := Equiv(Str(i));
+ end loop;
+ return WS;
+ end Equiv;
+
+ function X_Map(From : Wide_Character) return Wide_Character is
+ begin
+ return Equiv('X');
+ end X_Map;
+
+end CXA40120;
+
+
+
+with CXA40120;
+with Ada.Characters.Handling;
+with Ada.Strings.Wide_Maps;
+with Report;
+
+procedure CXA4012 is
+
+ use CXA40120;
+ use Ada.Strings;
+
+begin
+
+ Report.Test ("CXA4012", "Check that the types, operations, and other " &
+ "entities defined within the package " &
+ "Ada.Strings.Wide_Maps are available and " &
+ "produce correct results");
+
+ Test_Block:
+ declare
+
+ use type Wide_Maps.Wide_Character_Set;
+
+ MidPoint_Letter : constant := 13;
+ Last_Letter : constant := 26;
+
+ Vowels : constant Wide_Maps.Wide_Character_Sequence :=
+ Equiv("aeiou");
+ Quasi_Vowel : constant Wide_Character := Equiv('y');
+
+ Alphabet : Wide_Maps.Wide_Character_Sequence(1..Last_Letter);
+ Half_Alphabet : Wide_Maps.Wide_Character_Sequence(1..MidPoint_Letter);
+ Inverse_Alphabet : Wide_Maps.Wide_Character_Sequence(1..Last_Letter);
+
+ Alphabet_Set,
+ Consonant_Set,
+ Vowel_Set,
+ Full_Vowel_Set,
+ First_Half_Set,
+ Second_Half_Set : Wide_Maps.Wide_Character_Set := Wide_Maps.Null_Set;
+
+ begin
+
+ -- Load the alphabet string for use in creating sets.
+
+ for i in 0..MidPoint_Letter-1 loop
+ Half_Alphabet(i+1) :=
+ Wide_Character'Val(Wide_Character'Pos(Equiv('a')) + i);
+ end loop;
+
+ for i in 0..Last_Letter-1 loop
+ Alphabet(i+1) :=
+ Wide_Character'Val(Wide_Character'Pos(Equiv('a')) + i);
+ end loop;
+
+
+ -- Initialize a series of Wide_Character_Set objects.
+
+ Alphabet_Set := Wide_Maps.To_Set(Alphabet);
+ Vowel_Set := Wide_Maps.To_Set(Vowels);
+ Full_Vowel_Set := Vowel_Set OR Wide_Maps.To_Set(Quasi_Vowel);
+ Consonant_Set := Vowel_Set XOR Alphabet_Set;
+
+ First_Half_Set := Wide_Maps.To_Set(Half_Alphabet);
+ Second_Half_Set := Alphabet_Set XOR First_Half_Set;
+
+
+ -- Evaluation of Set objects, operators, and functions.
+
+ if Alphabet_Set /= (Vowel_Set OR Consonant_Set) then
+ Report.Failed("Incorrect set combinations using OR operator");
+ end if;
+
+
+ for i in Vowels'First .. Vowels'Last loop
+ if not Wide_Maps.Is_In(Vowels(i), Vowel_Set) or
+ not Wide_Maps.Is_In(Vowels(i), Alphabet_Set) or
+ Wide_Maps.Is_In(Vowels(i), Consonant_Set)
+ then
+ Report.Failed("Incorrect function Is_In use with set " &
+ "combinations - " & Integer'Image(i));
+ end if;
+ end loop;
+
+
+ if Wide_Maps.Is_Subset(Vowel_Set, First_Half_Set) or
+ Wide_Maps."<="(Vowel_Set, Second_Half_Set) or
+ not Wide_Maps.Is_Subset(Vowel_Set, Alphabet_Set)
+ then
+ Report.Failed
+ ("Incorrect set evaluation using Is_Subset function");
+ end if;
+
+
+ if not (Full_Vowel_Set = Wide_Maps.To_Set(Equiv("aeiouy"))) then
+ Report.Failed("Incorrect result for ""="" set operator");
+ end if;
+
+
+ if not ((Vowel_Set AND First_Half_Set) OR
+ (Full_Vowel_Set AND Second_Half_Set)) = Full_Vowel_Set then
+ Report.Failed
+ ("Incorrect result for AND, OR, or ""="" set operators");
+ end if;
+
+
+ if (Alphabet_Set AND Wide_Maps.Null_Set) /= Wide_Maps.Null_Set or
+ (Alphabet_Set OR Wide_Maps.Null_Set) /= Alphabet_Set
+ then
+ Report.Failed("Incorrect result for AND or OR set operators");
+ end if;
+
+
+ Vowel_Set := Full_Vowel_Set;
+ Vowel_Set := Vowel_Set AND (NOT Wide_Maps.To_Set(Quasi_Vowel));
+
+ if not (Vowels = Wide_Maps.To_Sequence(Vowel_Set)) then
+ Report.Failed("Incorrect Set to Sequence translation");
+ end if;
+
+
+ for i in 0..Last_Letter-1 loop
+ Inverse_Alphabet(i+1) := Alphabet(Last_Letter-i);
+ end loop;
+
+
+ -- Wide_Character_Mapping
+
+ declare
+ Inverse_Map : Wide_Maps.Wide_Character_Mapping :=
+ Wide_Maps.To_Mapping(Alphabet, Inverse_Alphabet);
+ begin
+ if Wide_Maps.Value(Wide_Maps.Identity, Equiv('b')) /=
+ Wide_Maps.Value(Inverse_Map, Equiv('y'))
+ then
+ Report.Failed("Incorrect Inverse mapping");
+ end if;
+ end;
+
+
+ -- Check that Translation_Error is raised when a character is
+ -- repeated in the parameter "From" string.
+ declare
+ Bad_Map : Wide_Maps.Wide_Character_Mapping;
+ begin
+ Bad_Map := Wide_Maps.To_Mapping(From => Equiv("aa"),
+ To => Equiv("yz"));
+ Report.Failed("Exception not raised with repeated character");
+ exception
+ when Translation_Error => null; -- OK
+ when others =>
+ Report.Failed("Incorrect exception raised in To_Mapping with " &
+ "a repeated character");
+ end;
+
+
+ -- Check that Translation_Error is raised when the parameters of the
+ -- function To_Mapping are of unequal lengths.
+ declare
+ Bad_Map : Wide_Maps.Wide_Character_Mapping;
+ begin
+ Bad_Map := Wide_Maps.To_Mapping(Equiv("abc"), Equiv("yz"));
+ Report.Failed
+ ("Exception not raised with unequal parameter lengths");
+ exception
+ when Translation_Error => null; -- OK
+ when others =>
+ Report.Failed("Incorrect exception raised in To_Mapping with " &
+ "unequal parameter lengths");
+ end;
+
+
+ -- Check that the access-to-subprogram type is defined and available.
+ -- This provides for one Wide_Character mapping capability only.
+ -- The actual mapping functionality will be tested in conjunction with
+ -- the tests of subprograms defined for Wide_String handling.
+
+ declare
+
+ X_Map_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
+ X_Map'Access;
+
+ begin
+ if X_Map_Ptr(Equiv('A')) /= -- both return 'X'
+ X_Map_Ptr.all(Equiv('Q'))
+ then
+ Report.Failed
+ ("Incorrect result using access-to-subprogram values");
+ end if;
+ end;
+
+
+ exception
+ when others => Report.Failed ("Exception raised in Test_Block");
+ end Test_Block;
+
+
+ Report.Result;
+
+end CXA4012;