blob: 05c66d4cc9f2ed05dccce092471d6c999e52e015 [file] [log] [blame]
-- CXA4027.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 versions of Ada.Strings.Bounded subprograms Translate,
-- (procedure and function), Index, and Count, which use the
-- Maps.Character_Mapping_Function input parameter, produce correct
-- results.
--
-- TEST DESCRIPTION:
-- This test examines the operation of several subprograms from within
-- the Ada.Strings.Bounded package that use the
-- Character_Mapping_Function mapping parameter to provide a 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.
--
--
-- CHANGE HISTORY:
-- 16 FEB 95 SAIC Initial prerelease version
-- 17 Jul 95 SAIC Incorporated reviewer comments. Replaced two
-- internally declared functions with two library
-- level functions to eliminate accessibility
-- problems.
--
--!
-- Function CXA4027_0 will return the lower case form of
-- the character input if it is in upper case, and return the input
-- character otherwise.
with Ada.Characters.Handling;
function CXA4027_0 (From : Character) return Character;
function CXA4027_0 (From : Character) return Character is
begin
return Ada.Characters.Handling.To_Lower(From);
end CXA4027_0;
-- Function CXA4027_1 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.
with Ada.Characters.Handling;
function CXA4027_1 (From : Character) return Character;
function CXA4027_1 (From : Character) return Character is
begin
return Ada.Characters.Handling.To_Upper(From);
end CXA4027_1;
with CXA4027_0, CXA4027_1;
with Ada.Strings.Bounded;
with Ada.Strings.Maps;
with Ada.Characters.Handling;
with Report;
procedure CXA4027 is
begin
Report.Test ("CXA4027", "Check that Ada.Strings.Bounded subprograms " &
"Translate, Index, and Count, which use the " &
"Character_Mapping_Function input parameter, " &
"produce correct results");
Test_Block:
declare
use Ada.Strings;
-- Functions used to supply mapping capability.
function Map_To_Lower_Case (From : Character) return Character
renames CXA4027_0;
function Map_To_Upper_Case (From : Character) return Character
renames CXA4027_1;
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;
-- Instantiations of Bounded String generic package.
package BS1 is new Ada.Strings.Bounded.Generic_Bounded_Length(1);
package BS20 is new Ada.Strings.Bounded.Generic_Bounded_Length(20);
package BS40 is new Ada.Strings.Bounded.Generic_Bounded_Length(40);
package BS80 is new Ada.Strings.Bounded.Generic_Bounded_Length(80);
use type BS1.Bounded_String, BS20.Bounded_String,
BS40.Bounded_String, BS80.Bounded_String;
String_1 : String(1..1) := "A";
String_20 : String(1..20) := "ABCDEFGHIJKLMNOPQRST";
String_40 : String(1..40) := "abcdefghijklmnopqrst" & String_20;
String_80 : String(1..80) := String_40 & String_40;
BString_1 : BS1.Bounded_String := BS1.Null_Bounded_String;
BString_20 : BS20.Bounded_String := BS20.Null_Bounded_String;
BString_40 : BS40.Bounded_String := BS40.Null_Bounded_String;
BString_80 : BS80.Bounded_String := BS80.Null_Bounded_String;
begin
-- Function Index.
if BS40.Index(BS40.To_Bounded_String("Package Strings.Bounded"),
Pattern => "s.b",
Going => Ada.Strings.Forward,
Mapping => Map_To_Lower_Case_Ptr) /= 15 or
BS80.Index(BS80.To_Bounded_String("STRING TRANSLATIONS SUBPROGRAMS"),
"tr",
Mapping => Map_To_Lower_Case_Ptr) /= 2 or
BS20.Index(BS20.To_Bounded_String("maximum number"),
"um",
Ada.Strings.Backward,
Map_To_Lower_Case_Ptr) /= 10 or
BS80.Index(BS80.To_Bounded_String("CoMpLeTeLy MiXeD CaSe StRiNg"),
"MIXED CASE STRING",
Ada.Strings.Forward,
Map_To_Upper_Case_Ptr) /= 12 or
BS40.Index(BS40.To_Bounded_String("STRING WITH NO MATCHING PATTERN"),
"WITH",
Ada.Strings.Backward,
Map_To_Lower_Case_Ptr) /= 0 or
BS80.Index(BS80.To_Bounded_String("THIS STRING IS IN UPPER CASE"),
"I",
Ada.Strings.Backward,
Map_To_Upper_Case_Ptr) /= 16 or
BS1.Index(BS1.Null_Bounded_String,
"i",
Mapping => Map_To_Lower_Case_Ptr) /= 0 or
BS40.Index(BS40.To_Bounded_String("AAABBBaaabbb"),
"aabb",
Mapping => Map_To_Lower_Case_Ptr) /= 2 or
BS80.Index(BS80.To_Bounded_String("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, using a " &
"Character Mapping Function parameter");
end if;
-- Function Index, Pattern_Error if Pattern = Null_String
declare
use BS20;
TC_Natural : Natural := 1000;
begin
TC_Natural := Index(To_Bounded_String("A Valid 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 BS20.Count(BS20.To_Bounded_String("ABABABA"),
Pattern => "aba",
Mapping => Map_To_Lower_Case_Ptr) /= 2 or
BS20.Count(BS20.To_Bounded_String("ABABABA"),
"ABA",
Map_To_Lower_Case_Ptr) /= 0 or
BS40.Count(BS40.To_Bounded_String("This IS a MISmatched issue"),
"is",
Map_To_Lower_Case_Ptr) /= 4 or
BS80.Count(BS80.To_Bounded_String("ABABABA"),
"ABA",
Map_To_Upper_Case_Ptr) /= 2 or
BS40.Count(BS40.To_Bounded_String("This IS a MISmatched issue"),
"is",
Map_To_Upper_Case_Ptr) /= 0 or
BS80.Count(BS80.To_Bounded_String
("Peter Piper and his Pickled Peppers"),
"p",
Map_To_Lower_Case_Ptr) /= 7 or
BS20.Count(BS20.To_Bounded_String("She sells sea shells"),
"s",
Map_To_Upper_Case_Ptr) /= 0 or
BS80.Count(BS80.To_Bounded_String("No matches what-so-ever"),
"matches",
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 BS80;
TC_Natural : Natural := 1000;
begin
TC_Natural := Count(To_Bounded_String("A Valid 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 BS40.Translate(BS40.To_Bounded_String("A Mixed Case String"),
Mapping => Map_To_Lower_Case_Ptr) /=
BS40.To_Bounded_String("a mixed case string") or
BS20."/="(BS20.Translate(BS20.To_Bounded_String("ALL LOWER CASE"),
Map_To_Lower_Case_Ptr),
"all lower case") or
BS20."/="("end with lower case",
BS20.Translate(
BS20.To_Bounded_String("end with lower case"),
Map_To_Lower_Case_Ptr)) or
BS1.Translate(BS1.Null_Bounded_String,
Map_To_Lower_Case_Ptr) /=
BS1.Null_Bounded_String or
BS80."/="(BS80.Translate(BS80.To_Bounded_String
("start with lower case, end with upper case"),
Map_To_Upper_Case_Ptr),
"START WITH LOWER CASE, END WITH UPPER CASE") or
BS40.Translate(BS40.To_Bounded_String("ALL UPPER CASE STRING"),
Map_To_Upper_Case_Ptr) /=
BS40.To_Bounded_String("ALL UPPER CASE STRING") or
BS80."/="(BS80.Translate(BS80.To_Bounded_String
("LoTs Of MiXeD CaSe ChArAcTeRs In ThE StRiNg"),
Map_To_Upper_Case_Ptr),
"LOTS OF MIXED CASE CHARACTERS IN THE STRING")
then
Report.Failed("Incorrect results from Function Translate, using " &
"a Character_Mapping_Function parameter");
end if;
-- Procedure Translate.
BString_1 := BS1.To_Bounded_String("A");
BS1.Translate(Source => BString_1, Mapping => Map_To_Lower_Case_Ptr);
if not BS1."="(BString_1, "a") then -- "=" for Bounded_String, String
Report.Failed("Incorrect result from Procedure Translate - 1");
end if;
BString_20 := BS20.To_Bounded_String(String_20);
BS20.Translate(BString_20, Mapping => Map_To_Lower_Case_Ptr);
if BString_20 /= BS20.To_Bounded_String("abcdefghijklmnopqrst") then
Report.Failed("Incorrect result from Procedure Translate - 2");
end if;
BString_40 := BS40.To_Bounded_String("String needing highlighting");
BS40.Translate(BString_40, Map_To_Upper_Case_Ptr);
if not (BString_40 = "STRING NEEDING HIGHLIGHTING") then
Report.Failed("Incorrect result from Procedure Translate - 3");
end if;
BString_80 := BS80.Null_Bounded_String;
BS80.Translate(BString_80, Map_To_Upper_Case_Ptr);
if not (BString_80 = BS80.Null_Bounded_String) then
Report.Failed("Incorrect result from Procedure Translate - 4");
end if;
exception
when others => Report.Failed ("Exception raised in Test_Block");
end Test_Block;
Report.Result;
end CXA4027;