From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; 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. --- gcc/testsuite/ada/acats/tests/cxa/cxa4026.a | 526 ++++++++++++++++++++++++++++ 1 file changed, 526 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/cxa/cxa4026.a (limited to 'gcc/testsuite/ada/acats/tests/cxa/cxa4026.a') 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; -- cgit v1.2.3