URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxa/] [cxa4026.a] - Rev 867
Go to most recent revision | Compare with Previous | Blame | View Log
-- 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;
Go to most recent revision | Compare with Previous | Blame | View Log