summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/cxa/cxa4026.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/cxa4026.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/cxa4026.a')
-rw-r--r--gcc/testsuite/ada/acats/tests/cxa/cxa4026.a526
1 files changed, 526 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4026.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4026.a
new file mode 100644
index 000000000..766979ad0
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/cxa/cxa4026.a
@@ -0,0 +1,526 @@
+-- CXA4026.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 Ada.Strings.Fixed procedures Head, Tail, and Trim, as well
+-- as the versions of subprograms Translate (procedure and function),
+-- Index, and Count, available in the package which use a
+-- Maps.Character_Mapping_Function input parameter, produce correct
+-- results.
+--
+-- TEST DESCRIPTION:
+-- This test examines the operation of several subprograms contained in
+-- the Ada.Strings.Fixed package.
+-- This includes procedure versions of Head, Tail, and Trim, as well as
+-- four subprograms that use a Character_Mapping_Function as a parameter
+-- to provide the mapping capability.
+--
+-- Two functions are defined to provide the mapping. Access values
+-- are defined to refer to these functions. One of the functions will
+-- map upper case characters in the range 'A'..'Z' to their lower case
+-- counterparts, while the other function will map lower case characters
+-- ('a'..'z', or a character whose position is in one of the ranges
+-- 223..246 or 248..255, provided the character has an upper case form)
+-- to their upper case form.
+--
+-- Function Index uses the mapping function access value to map the input
+-- string prior to searching for the appropriate index value to return.
+-- Function Count uses the mapping function access value to map the input
+-- string prior to counting the occurrences of the pattern string.
+-- Both the Procedure and Function version of Translate use the mapping
+-- function access value to perform the translation.
+--
+-- Results of all subprograms are compared with expected results.
+--
+--
+-- CHANGE HISTORY:
+-- 10 Feb 95 SAIC Initial prerelease version
+-- 21 Apr 95 SAIC Modified definition of string variable Str_2.
+--
+--!
+
+
+package CXA4026_0 is
+
+ -- Function Map_To_Lower_Case will return the lower case form of
+ -- Characters in the range 'A'..'Z' only, and return the input
+ -- character otherwise.
+
+ function Map_To_Lower_Case (From : Character) return Character;
+
+
+ -- Function Map_To_Upper_Case will return the upper case form of
+ -- Characters in the range 'a'..'z', or whose position is in one
+ -- of the ranges 223..246 or 248..255, provided the character has
+ -- an upper case form.
+
+ function Map_To_Upper_Case (From : Character) return Character;
+
+end CXA4026_0;
+
+
+with Ada.Characters.Handling;
+package body CXA4026_0 is
+
+ function Map_To_Lower_Case (From : Character) return Character is
+ begin
+ if From in 'A'..'Z' then
+ return Character'Val(Character'Pos(From) -
+ (Character'Pos('A') - Character'Pos('a')));
+ else
+ return From;
+ end if;
+ end Map_To_Lower_Case;
+
+ function Map_To_Upper_Case (From : Character) return Character is
+ begin
+ return Ada.Characters.Handling.To_Upper(From);
+ end Map_To_Upper_Case;
+
+end CXA4026_0;
+
+
+with CXA4026_0;
+with Ada.Strings.Fixed;
+with Ada.Strings.Maps;
+with Ada.Characters.Handling;
+with Ada.Characters.Latin_1;
+with Report;
+
+procedure CXA4026 is
+
+begin
+
+ Report.Test ("CXA4026", "Check that procedures Trim, Head, and Tail, " &
+ "as well as the versions of subprograms " &
+ "Translate, Index, and Count, which use the " &
+ "Character_Mapping_Function input parameter," &
+ "produce correct results");
+
+ Test_Block:
+ declare
+
+ use Ada.Strings, CXA4026_0;
+
+ -- The following strings are used in examination of the Translation
+ -- subprograms.
+
+ New_Character_String : String(1..10) :=
+ Ada.Characters.Latin_1.LC_A_Grave &
+ Ada.Characters.Latin_1.LC_A_Ring &
+ Ada.Characters.Latin_1.LC_AE_Diphthong &
+ Ada.Characters.Latin_1.LC_C_Cedilla &
+ Ada.Characters.Latin_1.LC_E_Acute &
+ Ada.Characters.Latin_1.LC_I_Circumflex &
+ Ada.Characters.Latin_1.LC_Icelandic_Eth &
+ Ada.Characters.Latin_1.LC_N_Tilde &
+ Ada.Characters.Latin_1.LC_O_Oblique_Stroke &
+ Ada.Characters.Latin_1.LC_Icelandic_Thorn;
+
+
+ TC_New_Character_String : String(1..10) :=
+ Ada.Characters.Latin_1.UC_A_Grave &
+ Ada.Characters.Latin_1.UC_A_Ring &
+ Ada.Characters.Latin_1.UC_AE_Diphthong &
+ Ada.Characters.Latin_1.UC_C_Cedilla &
+ Ada.Characters.Latin_1.UC_E_Acute &
+ Ada.Characters.Latin_1.UC_I_Circumflex &
+ Ada.Characters.Latin_1.UC_Icelandic_Eth &
+ Ada.Characters.Latin_1.UC_N_Tilde &
+ Ada.Characters.Latin_1.UC_O_Oblique_Stroke &
+ Ada.Characters.Latin_1.UC_Icelandic_Thorn;
+
+
+ -- Functions used to supply mapping capability.
+
+
+ -- Access objects that will be provided as parameters to the
+ -- subprograms.
+
+ Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function :=
+ Map_To_Lower_Case'Access;
+
+ Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function :=
+ Map_To_Upper_Case'Access;
+
+
+ begin
+
+ -- Function Index, Forward direction search.
+ -- Note: Several of the following cases use the default value
+ -- Forward for the Going parameter.
+
+ if Fixed.Index(Source => "The library package Strings.Fixed",
+ Pattern => "fix",
+ Going => Ada.Strings.Forward,
+ Mapping => Map_To_Lower_Case_Ptr) /= 29 or
+ Fixed.Index("THE RAIN IN SPAIN FALLS MAINLY ON THE PLAIN",
+ "ain",
+ Mapping => Map_To_Lower_Case_Ptr) /= 6 or
+ Fixed.Index("maximum number",
+ "um",
+ Ada.Strings.Forward,
+ Map_To_Lower_Case_Ptr) /= 6 or
+ Fixed.Index("CoMpLeTeLy MiXeD CaSe StRiNg",
+ "MIXED CASE STRING",
+ Ada.Strings.Forward,
+ Map_To_Upper_Case_Ptr) /= 12 or
+ Fixed.Index("STRING WITH NO MATCHING PATTERNS",
+ "WITH",
+ Ada.Strings.Forward,
+ Map_To_Lower_Case_Ptr) /= 0 or
+ Fixed.Index("THIS STRING IS IN UPPER CASE",
+ "IS",
+ Ada.Strings.Forward,
+ Map_To_Upper_Case_Ptr) /= 3 or
+ Fixed.Index("", -- Null string.
+ "is",
+ Mapping => Map_To_Lower_Case_Ptr) /= 0 or
+ Fixed.Index("AAABBBaaabbb",
+ "aabb",
+ Mapping => Map_To_Lower_Case_Ptr) /= 2
+ then
+ Report.Failed("Incorrect results from Function Index, going " &
+ "in Forward direction, using a Character Mapping " &
+ "Function parameter");
+ end if;
+
+
+
+ -- Function Index, Backward direction search.
+
+ if Fixed.Index("Case of a Mixed Case String",
+ "case",
+ Ada.Strings.Backward,
+ Map_To_Lower_Case_Ptr) /= 17 or
+ Fixed.Index("Case of a Mixed Case String",
+ "CASE",
+ Ada.Strings.Backward,
+ Map_To_Upper_Case_Ptr) /= 17 or
+ Fixed.Index("rain, Rain, and more RAIN",
+ "rain",
+ Ada.Strings.Backward,
+ Map_To_Lower_Case_Ptr) /= 22 or
+ Fixed.Index("RIGHT place, right time",
+ "RIGHT",
+ Ada.Strings.Backward,
+ Map_To_Upper_Case_Ptr) /= 14 or
+ Fixed.Index("WOULD MATCH BUT FOR THE CASE",
+ "WOULD MATCH BUT FOR THE CASE",
+ Ada.Strings.Backward,
+ Map_To_Lower_Case_Ptr) /= 0
+ then
+ Report.Failed("Incorrect results from Function Index, going " &
+ "in Backward direction, using a Character Mapping " &
+ "Function parameter");
+ end if;
+
+
+
+ -- Function Index, Pattern_Error if Pattern = Null_String
+
+ declare
+ use Ada.Strings.Fixed;
+ Null_Pattern_String : constant String := "";
+ TC_Natural : Natural := 1000;
+ begin
+ TC_Natural := Index("A Valid String",
+ Null_Pattern_String,
+ Ada.Strings.Forward,
+ Map_To_Lower_Case_Ptr);
+ Report.Failed("Pattern_Error not raised by Function Index when " &
+ "given a null pattern string");
+ exception
+ when Pattern_Error => null; -- OK, expected exception.
+ when others =>
+ Report.Failed("Incorrect exception raised by Function Index " &
+ "using a Character Mapping Function parameter " &
+ "when given a null pattern string");
+ end;
+
+
+
+ -- Function Count.
+
+ if Fixed.Count(Source => "ABABABA",
+ Pattern => "aba",
+ Mapping => Map_To_Lower_Case_Ptr) /= 2 or
+ Fixed.Count("ABABABA", "ABA", Map_To_Lower_Case_Ptr) /= 0 or
+ Fixed.Count("This IS a MISmatched issue",
+ "is",
+ Map_To_Lower_Case_Ptr) /= 4 or
+ Fixed.Count("ABABABA", "ABA", Map_To_Upper_Case_Ptr) /= 2 or
+ Fixed.Count("This IS a MISmatched issue",
+ "is",
+ Map_To_Upper_Case_Ptr) /= 0 or
+ Fixed.Count("She sells sea shells by the sea shore",
+ "s",
+ Map_To_Lower_Case_Ptr) /= 8 or
+ Fixed.Count("", -- Null string.
+ "match",
+ Map_To_Upper_Case_Ptr) /= 0
+ then
+ Report.Failed("Incorrect results from Function Count, using " &
+ "a Character Mapping Function parameter");
+ end if;
+
+
+
+ -- Function Count, Pattern_Error if Pattern = Null_String
+
+ declare
+ use Ada.Strings.Fixed;
+ Null_Pattern_String : constant String := "";
+ TC_Natural : Natural := 1000;
+ begin
+ TC_Natural := Count("A Valid String",
+ Null_Pattern_String,
+ Map_To_Lower_Case_Ptr);
+ Report.Failed("Pattern_Error not raised by Function Count using " &
+ "a Character Mapping Function parameter when " &
+ "given a null pattern string");
+ exception
+ when Pattern_Error => null; -- OK, expected exception.
+ when others =>
+ Report.Failed("Incorrect exception raised by Function Count " &
+ "using a Character Mapping Function parameter " &
+ "when given a null pattern string");
+ end;
+
+
+
+ -- Function Translate.
+
+ if Fixed.Translate(Source => "A Sample Mixed Case String",
+ Mapping => Map_To_Lower_Case_Ptr) /=
+ "a sample mixed case string" or
+
+ Fixed.Translate("ALL LOWER CASE",
+ Map_To_Lower_Case_Ptr) /=
+ "all lower case" or
+
+ Fixed.Translate("end with lower case",
+ Map_To_Lower_Case_Ptr) /=
+ "end with lower case" or
+
+ Fixed.Translate("", Map_To_Lower_Case_Ptr) /=
+ "" or
+
+ Fixed.Translate("start with lower case",
+ Map_To_Upper_Case_Ptr) /=
+ "START WITH LOWER CASE" or
+
+ Fixed.Translate("ALL UPPER CASE STRING",
+ Map_To_Upper_Case_Ptr) /=
+ "ALL UPPER CASE STRING" or
+
+ Fixed.Translate("LoTs Of MiXeD CaSe ChArAcTeRs",
+ Map_To_Upper_Case_Ptr) /=
+ "LOTS OF MIXED CASE CHARACTERS" or
+
+ Fixed.Translate("", Map_To_Upper_Case_Ptr) /=
+ "" or
+
+ Fixed.Translate(New_Character_String,
+ Map_To_Upper_Case_Ptr) /=
+ TC_New_Character_String
+ then
+ Report.Failed("Incorrect results from Function Translate, using " &
+ "a Character Mapping Function parameter");
+ end if;
+
+
+
+ -- Procedure Translate.
+
+ declare
+
+ use Ada.Strings.Fixed;
+
+ Str_1 : String(1..24) := "AN ALL UPPER CASE STRING";
+ Str_2 : String(1..19) := "A Mixed Case String";
+ Str_3 : String(1..32) := "a string with lower case letters";
+ TC_Str_1 : constant String := Str_1;
+ TC_Str_3 : constant String := Str_3;
+
+ begin
+
+ Translate(Source => Str_1, Mapping => Map_To_Lower_Case_Ptr);
+
+ if Str_1 /= "an all upper case string" then
+ Report.Failed("Incorrect result from Procedure Translate - 1");
+ end if;
+
+ Translate(Source => Str_1, Mapping => Map_To_Upper_Case_Ptr);
+
+ if Str_1 /= TC_Str_1 then
+ Report.Failed("Incorrect result from Procedure Translate - 2");
+ end if;
+
+ Translate(Source => Str_2, Mapping => Map_To_Lower_Case_Ptr);
+
+ if Str_2 /= "a mixed case string" then
+ Report.Failed("Incorrect result from Procedure Translate - 3");
+ end if;
+
+ Translate(Source => Str_2, Mapping => Map_To_Upper_Case_Ptr);
+
+ if Str_2 /= "A MIXED CASE STRING" then
+ Report.Failed("Incorrect result from Procedure Translate - 4");
+ end if;
+
+ Translate(Source => Str_3, Mapping => Map_To_Lower_Case_Ptr);
+
+ if Str_3 /= TC_Str_3 then
+ Report.Failed("Incorrect result from Procedure Translate - 5");
+ end if;
+
+ Translate(Source => Str_3, Mapping => Map_To_Upper_Case_Ptr);
+
+ if Str_3 /= "A STRING WITH LOWER CASE LETTERS" then
+ Report.Failed("Incorrect result from Procedure Translate - 6");
+ end if;
+
+ Translate(New_Character_String, Map_To_Upper_Case_Ptr);
+
+ if New_Character_String /= TC_New_Character_String then
+ Report.Failed("Incorrect result from Procedure Translate - 6");
+ end if;
+
+ end;
+
+
+ -- Procedure Trim.
+
+ declare
+ Use Ada.Strings.Fixed;
+ Trim_String : String(1..30) := " A string of characters ";
+ begin
+
+ Trim(Source => Trim_String,
+ Side => Ada.Strings.Left,
+ Justify => Ada.Strings.Right,
+ Pad => 'x');
+
+ if Trim_String /= "xxxxA string of characters " then
+ Report.Failed("Incorrect result from Procedure Trim, trim " &
+ "side = left, justify = right, pad = x");
+ end if;
+
+ Trim(Trim_String, Ada.Strings.Right, Ada.Strings.Center);
+
+ if Trim_String /= " xxxxA string of characters " then
+ Report.Failed("Incorrect result from Procedure Trim, trim " &
+ "side = right, justify = center, default pad");
+ end if;
+
+ Trim(Trim_String, Ada.Strings.Both, Pad => '*');
+
+ if Trim_String /= "xxxxA string of characters****" then
+ Report.Failed("Incorrect result from Procedure Trim, trim " &
+ "side = both, default justify, pad = *");
+ end if;
+
+ end;
+
+
+ -- Procedure Head.
+
+ declare
+ Fixed_String : String(1..20) := "A sample test string";
+ begin
+
+ Fixed.Head(Source => Fixed_String,
+ Count => 14,
+ Justify => Ada.Strings.Center,
+ Pad => '$');
+
+ if Fixed_String /= "$$$A sample test $$$" then
+ Report.Failed("Incorrect result from Procedure Head, " &
+ "justify = center, pad = $");
+ end if;
+
+ Fixed.Head(Fixed_String, 11, Ada.Strings.Right);
+
+ if Fixed_String /= " $$$A sample" then
+ Report.Failed("Incorrect result from Procedure Head, " &
+ "justify = right, default pad");
+ end if;
+
+ Fixed.Head(Fixed_String, 9, Pad => '*');
+
+ if Fixed_String /= " ***********" then
+ Report.Failed("Incorrect result from Procedure Head, " &
+ "default justify, pad = *");
+ end if;
+
+ end;
+
+
+ -- Procedure Tail.
+
+ declare
+ Use Ada.Strings.Fixed;
+ Tail_String : String(1..20) := "ABCDEFGHIJKLMNOPQRST";
+ begin
+
+ Tail(Source => Tail_String, Count => 10, Pad => '-');
+
+ if Tail_String /= "KLMNOPQRST----------" then
+ Report.Failed("Incorrect result from Procedure Tail, " &
+ "default justify, pad = -");
+ end if;
+
+ Tail(Tail_String, 6, Justify => Ada.Strings.Center, Pad => 'a');
+
+ if Tail_String /= "aaaaaaa------aaaaaaa" then
+ Report.Failed("Incorrect result from Procedure Tail, " &
+ "justify = center, pad = a");
+ end if;
+
+ Tail(Tail_String, 1, Ada.Strings.Right);
+
+ if Tail_String /= " a" then
+ Report.Failed("Incorrect result from Procedure Tail, " &
+ "justify = right, default pad");
+ end if;
+
+ Tail(Tail_String, 19, Ada.Strings.Right, 'A');
+
+ if Tail_String /= "A a" then
+ Report.Failed("Incorrect result from Procedure Tail, " &
+ "justify = right, pad = A");
+ end if;
+
+ end;
+
+ exception
+ when others => Report.Failed ("Exception raised in Test_Block");
+ end Test_Block;
+
+
+ Report.Result;
+
+end CXA4026;