summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/cxa/cxa4029.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/cxa4029.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/cxa4029.a')
-rw-r--r--gcc/testsuite/ada/acats/tests/cxa/cxa4029.a333
1 files changed, 333 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4029.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4029.a
new file mode 100644
index 000000000..714067454
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/cxa/cxa4029.a
@@ -0,0 +1,333 @@
+-- CXA4029.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 functionality found in packages Ada.Strings.Wide_Maps,
+-- Ada.Strings.Wide_Bounded, and Ada.Strings.Wide_Maps.Wide_Constants
+-- is available and produces correct results.
+--
+-- TEST DESCRIPTION:
+-- This test tests the subprograms found in the
+-- Ada.Strings.Wide_Bounded package. It is based on the tests
+-- CXA4027-28, which are tests for the complementary "non-wide"
+-- packages.
+--
+-- The functions found in CXA4029_0 provide mapping capability, when
+-- used in conjunction with Wide_Character_Mapping_Function objects.
+--
+--
+-- CHANGE HISTORY:
+-- 23 Jun 95 SAIC Initial prerelease version.
+-- 18 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1.
+--
+--!
+
+package CXA4029_0 is
+ -- Functions used to supply mapping capability.
+ function Map_To_Lower_Case (From : Wide_Character) return Wide_Character;
+ function Map_To_Upper_Case (From : Wide_Character) return Wide_Character;
+end CXA4029_0;
+
+with Ada.Characters.Handling;
+package body CXA4029_0 is
+ -- Function Map_To_Lower_Case will return the lower case form of
+ -- Wide_Characters in the range 'A'..'Z' only, and return the input
+ -- wide_character otherwise.
+
+ function Map_To_Lower_Case (From : Wide_Character)
+ return Wide_Character is
+ begin
+ return Ada.Characters.Handling.To_Wide_Character(
+ Ada.Characters.Handling.To_Lower(
+ Ada.Characters.Handling.To_Character(From)));
+ end Map_To_Lower_Case;
+
+ -- Function Map_To_Upper_Case will return the upper case form of
+ -- Wide_Characters in the range 'a'..'z', or whose position is in one
+ -- of the ranges 223..246 or 248..255, provided the wide_character has
+ -- an upper case form.
+
+ function Map_To_Upper_Case (From : Wide_Character)
+ return Wide_Character is
+ begin
+ return Ada.Characters.Handling.To_Wide_Character(
+ Ada.Characters.Handling.To_Upper(
+ Ada.Characters.Handling.To_Character(From)));
+ end Map_To_Upper_Case;
+
+end CXA4029_0;
+
+
+with CXA4029_0;
+with Report;
+with Ada.Characters.Handling;
+with Ada.Characters.Latin_1;
+with Ada.Strings;
+with Ada.Strings.Wide_Maps;
+with Ada.Strings.Wide_Maps.Wide_Constants;
+with Ada.Strings.Wide_Fixed;
+with Ada.Strings.Wide_Bounded;
+
+procedure CXA4029 is
+begin
+ Report.Test ("CXA4029",
+ "Check that subprograms defined in package " &
+ "Ada.Strings.Wide_Bounded produce correct results");
+
+ Test_Block:
+ declare
+
+ package ACL1 renames Ada.Characters.Latin_1;
+ package BS1 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(1);
+ package BS20 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(20);
+ package BS40 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(40);
+ package BS80 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(80);
+
+ subtype LC_Characters is Wide_Character range 'a'..'z';
+
+ use Ada.Characters, Ada.Strings;
+ use type Wide_Maps.Wide_Character_Set;
+ use type BS1.Bounded_Wide_String, BS20.Bounded_Wide_String,
+ BS40.Bounded_Wide_String, BS80.Bounded_Wide_String;
+
+ TC_String : constant Wide_String := "A Standard String";
+
+ BString_1 : BS1.Bounded_Wide_String :=
+ BS1.Null_Bounded_Wide_String;
+ BString_20 : BS20.Bounded_Wide_String :=
+ BS20.Null_Bounded_Wide_String;
+ BString_40 : BS40.Bounded_Wide_String :=
+ BS40.Null_Bounded_Wide_String;
+ BString_80 : BS80.Bounded_Wide_String :=
+ BS80.Null_Bounded_Wide_String;
+ String_20 : Wide_String(1..20) := "ABCDEFGHIJKLMNOPQRST";
+ String_40 : Wide_String(1..40) := "abcdefghijklmnopqrst" &
+ String_20;
+ String_80 : Wide_String(1..80) := String_40 & String_40;
+ TC_String_5 : Wide_String(1..5) := "ABCDE";
+
+ -- The following strings are used in examination of the Translation
+ -- subprograms.
+ New_Character_String : Wide_String(1..10) :=
+ Handling.To_Wide_String(
+ ACL1.LC_A_Grave & ACL1.LC_A_Ring & ACL1.LC_AE_Diphthong &
+ ACL1.LC_C_Cedilla & ACL1.LC_E_Acute & ACL1.LC_I_Circumflex &
+ ACL1.LC_Icelandic_Eth & ACL1.LC_N_Tilde &
+ ACL1.LC_O_Oblique_Stroke & ACL1.LC_Icelandic_Thorn);
+
+ TC_New_Character_String : Wide_String(1..10) :=
+ Handling.To_Wide_String(
+ ACL1.UC_A_Grave & ACL1.UC_A_Ring & ACL1.UC_AE_Diphthong &
+ ACL1.UC_C_Cedilla & ACL1.UC_E_Acute & ACL1.UC_I_Circumflex &
+ ACL1.UC_Icelandic_Eth & ACL1.UC_N_Tilde &
+ ACL1.UC_O_Oblique_Stroke & ACL1.UC_Icelandic_Thorn);
+
+ -- Access objects that will be provided as parameters to the
+ -- subprograms.
+ Map_To_Lower_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
+ CXA4029_0.Map_To_Lower_Case'Access;
+ Map_To_Upper_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
+ CXA4029_0.Map_To_Upper_Case'Access;
+
+ begin
+
+ -- Testing of functionality found in Package Ada.Strings.Wide_Bounded.
+ --
+ -- Function Index.
+
+ if BS80.Index(BS80.To_Bounded_Wide_String("CoMpLeTeLy MiXeD CaSe"),
+ "MIXED CASE",
+ Ada.Strings.Forward,
+ Map_To_Upper_Case_Ptr) /= 12 or
+ BS1.Index(BS1.Null_Bounded_Wide_String,
+ "i",
+ Mapping => Map_To_Lower_Case_Ptr) /= 0
+ then
+ Report.Failed("Incorrect results from BND Function Index, going " &
+ "in Forward direction, using a Character Mapping " &
+ "Function parameter");
+ end if;
+
+ -- Function Count.
+ if BS40.Count(BS40.To_Bounded_Wide_String("This IS a MISmatched issue"),
+ "is",
+ Map_To_Lower_Case_Ptr) /= 4 or
+ BS80.Count(BS80.To_Bounded_Wide_String("ABABABA"),
+ "ABA",
+ Map_To_Upper_Case_Ptr) /= 2
+ then
+ Report.Failed("Incorrect results from BND Function Count, using " &
+ "a Character_Mapping_Function parameter");
+ end if;
+
+ -- Function Translate.
+ if BS40.Translate(BS40.To_Bounded_Wide_String("A Mixed Case String"),
+ Mapping => Map_To_Lower_Case_Ptr) /=
+ BS40.To_Bounded_Wide_String("a mixed case string") or
+ BS20."/="("end with lower case",
+ BS20.Translate(
+ BS20.To_Bounded_Wide_String("end with lower case"),
+ Map_To_Lower_Case_Ptr))
+ then
+ Report.Failed("Incorrect results from BND Function Translate, " &
+ "using a Character_Mapping_Function parameter");
+ end if;
+
+ -- Procedure Translate.
+ BString_20 := BS20.To_Bounded_Wide_String(String_20);
+ BS20.Translate(BString_20, Mapping => Map_To_Lower_Case_Ptr);
+ if BString_20 /= BS20.To_Bounded_Wide_String("abcdefghijklmnopqrst")
+ then
+ Report.Failed("Incorrect result from BND Procedure Translate - 1");
+ end if;
+
+ BString_80 := BS80.Null_Bounded_Wide_String;
+ BS80.Translate(BString_80, Map_To_Upper_Case_Ptr);
+ if not (BString_80 = BS80.Null_Bounded_Wide_String) then
+ Report.Failed("Incorrect result from BND Procedure Translate - 2");
+ end if;
+
+ -- Procedure Append.
+ declare
+ use BS20;
+ begin
+ BString_20 := BS20.Null_Bounded_Wide_String;
+ Append(BString_20, 'T');
+ Append(BString_20, "his string");
+ Append(BString_20,
+ To_Bounded_Wide_String(" is complete."),
+ Drop => Ada.Strings.Right); -- Drop 4 characters.
+ if BString_20 /= To_Bounded_Wide_String("This string is compl") then
+ Report.Failed("Incorrect results from BS20 versions of " &
+ "procedure Append");
+ end if;
+ exception
+ when others => Report.Failed("Exception raised in block checking " &
+ "BND Procedure Append");
+ end;
+
+ -- Operator "=".
+ BString_40 := BS40.To_Bounded_Wide_String(String_40);
+ BString_80 := BS80.To_Bounded_Wide_String(
+ BS40.To_Wide_String(BString_40) &
+ BS40.To_Wide_String(BString_40));
+ if not (BString_40 = String_40 and
+ BS80."="(String_80, BString_80)) then
+ Report.Failed("Incorrect results from BND Function ""="" with " &
+ "string - bounded string parameter combinations");
+ end if;
+
+ -- Operator "<".
+ BString_1 := BS1.To_Bounded_Wide_String("cat",
+ Drop => Ada.Strings.Right);
+ BString_20 := BS20.To_Bounded_Wide_String("Santa Claus");
+ if BString_1 < "C" or
+ BS1."<"(BString_1,"c") or
+ BS1."<"("x", BString_1) or
+ BS20."<"(BString_20,"Santa ") or
+ BS20."<"("Santa and his Elves", BString_20)
+ then
+ Report.Failed("Incorrect results from BND Function ""<"" with " &
+ "string - bounded string parameter combinations");
+ end if;
+
+ -- Operator "<=".
+ BString_20 := BS20.To_Bounded_Wide_String("Sample string");
+ if BS20."<="(BString_20,"Sample strin") or
+ not(BS20."<="("Sample string",BString_20))
+ then
+ Report.Failed("Incorrect results from BND Function ""<="" with " &
+ "string - bounded string parameter combinations");
+ end if;
+
+ -- Operator ">".
+ BString_40 := BS40.To_Bounded_Wide_String(
+ "A MUCH LONGER SAMPLE STRING.");
+ if BString_40 > "A much longer sample string" or
+ BS40.To_Bounded_Wide_String("ABCDEFGH") > "abcdefgh"
+ then
+ Report.Failed("Incorrect results from BND Function "">"" with " &
+ "string - bounded string parameter combinations");
+ end if;
+
+ -- Operator ">=".
+ BString_80 := BS80.To_Bounded_Wide_String(String_80);
+ if not (BString_80 >= String_80 and
+ BS80.To_Bounded_Wide_String("Programming") >= "PROGRAMMING" and
+ BS80.">="("test", BS80.To_Bounded_Wide_String("tess")))
+ then
+ Report.Failed("Incorrect results from BND Function "">="" with " &
+ "string - bounded string parameter combinations");
+ end if;
+
+ -- Procedure Trim
+ BString_20 := BS20.To_Bounded_Wide_String(" Both Sides ");
+ BS20.Trim(BString_20, Ada.Strings.Both);
+ if BString_20 /= BS20.To_Bounded_Wide_String("Both Sides") then
+ Report.Failed("Incorrect results from BND Procedure Trim with " &
+ "Side = Both");
+ end if;
+
+ -- Procedure Head
+ BString_40 := BS40.To_Bounded_Wide_String("Test String");
+ BS40.Head(Source => BString_40,
+ Count => 4); -- Count < Source'Length
+ if BString_40 /= BS40.To_Bounded_Wide_String("Test") then
+ Report.Failed("Incorrect results from BND Procedure Head with " &
+ "the Count parameter less than Source'Length");
+ end if;
+
+ BString_20 := BS20.To_Bounded_Wide_String("Short String");
+ BS20.Head(BString_20, 23, '-', Ada.Strings.Right);
+ if BS20.To_Bounded_Wide_String("Short String--------") /= BString_20 then
+ Report.Failed("Incorrect results from BND Procedure Head with " &
+ "the Count parameter greater than Source'Length, " &
+ "and the Drop parameter = Right");
+ end if;
+
+ -- Procedure Tail
+ BString_40 := BS40.To_Bounded_Wide_String("Test String");
+ BS40.Tail(Source => BString_40,
+ Count => 6);
+ if BString_40 /= BS40.To_Bounded_Wide_String("String") then
+ Report.Failed("Incorrect results from BND Procedure Tail with " &
+ "the Count parameter less than Source'Length");
+ end if;
+
+ BString_20 := BS20.To_Bounded_Wide_String("Maximum Length Chars");
+ BS20.Tail(BString_20, 23, '-', Ada.Strings.Right);
+ if BS20.To_Bounded_Wide_String("---Maximum Length Ch") /= BString_20 then
+ Report.Failed("Incorrect results from BND Procedure Tail with " &
+ "the Count parameter greater than Source'Length, " &
+ "and the Drop parameter = Right");
+ end if;
+
+ exception
+ when others => Report.Failed ("Exception raised in Test_Block");
+ end Test_Block;
+
+ Report.Result;
+
+end CXA4029;