📄 cxa4020.a
字号:
-- CXA4020.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 subprograms defined in package Ada.Strings.Wide_Bounded-- are available, and that they produce correct results, especially under-- conditions where truncation of the result is required. Specifically, -- check the subprograms Overwrite (function and procedure), Delete,-- Function Trim (blanks), Trim (Set wide characters, function and-- procedure), Head, Tail, and Replicate (wide characters and wide -- strings).---- TEST DESCRIPTION:-- This test, in conjunction with tests CXA4017, CXA4018, CXA4019, -- will provide coverage of the most common usages of the functionality-- found in the Ada.Strings.Wide_Bounded package. It deals in large part-- with truncation effects and options. This test contains many small, -- specific test cases, situations that are often difficult to generate -- in large numbers in an application-based test. These cases represent -- specific usage paradigms in-the-small.---- -- CHANGE HISTORY:-- 06 Dec 94 SAIC ACVC 2.0-- 22 Dec 94 SAIC Changed obsolete constant to Strings.Wide_Space.-- 13 Apr 95 SAIC Corrected certain subtest acceptance conditions.----!with Report;with Ada.Characters.Handling;with Ada.Strings.Wide_Bounded;with Ada.Strings.Wide_Maps;procedure CXA4020 is -- The following two functions are used to translate character and string -- values to "Wide" values. They will be applied to all the Wide_Bounded -- subprogram parameters to simulate the use of Wide_Characters and -- Wide_Strings in actual practice. Blanks are translated to Wide_Character -- blanks and all other characters are translated into Wide_Characters with -- position values 256 greater than their (narrow) character position -- values. function Translate (Ch : Character) return Wide_Character is C : Character := Ch; begin if Ch = ' ' then return Ada.Characters.Handling.To_Wide_Character(C); else return Wide_Character'Val(Character'Pos(Ch) + Character'Pos(Character'Last) + 1); end if; end Translate; function Translate (Str : String) return Wide_String is WS : Wide_String(Str'First..Str'Last); begin for i in Str'First..Str'Last loop WS(i) := Translate(Str(i)); end loop; return WS; end Translate;begin Report.Test("CXA4020", "Check that the subprograms defined in " & "package Ada.Strings.Wide_Bounded are " & "available, and that they produce correct " & "results, especially under conditions where " & "truncation of the result is required"); Test_Block: declare package AS renames Ada.Strings; package ASW renames Ada.Strings.Wide_Bounded; package Maps renames Ada.Strings.Wide_Maps; package B10 is new ASW.Generic_Bounded_Length(Max => 10); use type B10.Bounded_Wide_String; Result_String : B10.Bounded_Wide_String; Test_String : B10.Bounded_Wide_String; AtoE_Bnd_Str : B10.Bounded_Wide_String := B10.To_Bounded_Wide_String(Translate("abcde")); FtoJ_Bnd_Str : B10.Bounded_Wide_String := B10.To_Bounded_Wide_String(Translate("fghij")); AtoJ_Bnd_Str : B10.Bounded_Wide_String := B10.To_Bounded_Wide_String(Translate("abcdefghij")); Location : Natural := 0; Total_Count : Natural := 0; CD_Set : Maps.Wide_Character_Set := Maps.To_Set(Translate("cd")); XY_Set : Maps.Wide_Character_Set := Maps.To_Set(Translate("xy")); begin -- Function Overwrite with Truncation -- Drop = Error (Default). begin Test_String := AtoJ_Bnd_Str; Result_String := B10.Overwrite(Source => Test_String, -- "abcdefghij" Position => 9, New_Item => Translate("xyz"), Drop => AS.Error); Report.Failed("Exception not raised by Function Overwrite"); exception when AS.Length_Error => null; -- Expected exception raised. when others => Report.Failed("Incorrect exception raised by Function Overwrite"); end; -- Drop = Left Result_String := B10.Overwrite(Source => Test_String, -- "abcdefghij" Position => B10.Length(Test_String), -- 10 New_Item => Translate("xyz"), Drop => Ada.Strings.Left); if B10.To_Wide_String(Result_String) /= Translate("cdefghixyz") then -- drop a,b Report.Failed ("Incorrect result from Function Overwrite, Drop = Left"); end if; -- Drop = Right Result_String := B10.Overwrite(Test_String, -- "abcdefghij" 3, Translate("xxxyyyzzz"), Ada.Strings.Right); if B10.To_Wide_String(Result_String) /= Translate("abxxxyyyzz") then Report.Failed ("Incorrect result from Function Overwrite, Drop = Right"); end if; -- Additional cases of function Overwrite. if B10.Overwrite(B10.To_Bounded_Wide_String(Translate("a")), 1, -- Source length = 1 Translate(" abc ")) /= B10.To_Bounded_Wide_String(Translate(" abc ")) or B10.Overwrite(B10.Null_Bounded_Wide_String, -- Null source 1, Translate("abcdefghij")) /= AtoJ_Bnd_Str or B10.Overwrite(AtoE_Bnd_Str, B10.To_Wide_String(AtoE_Bnd_Str)'First, Translate(" ")) /= -- New_Item = 1 B10.To_Bounded_Wide_String(Translate(" bcde")) then Report.Failed("Incorrect result from Function Overwrite"); end if; -- Procedure Overwrite -- Correct usage, no truncation. Test_String := AtoE_Bnd_Str; -- "abcde" B10.Overwrite(Test_String, 2, Translate("xyz")); if Test_String /= B10.To_Bounded_Wide_String(Translate("axyze")) then Report.Failed("Incorrect result from Procedure Overwrite - 1"); end if; Test_String := B10.To_Bounded_Wide_String(Translate("abc")); B10.Overwrite(Test_String, 2, ""); -- New_Item is null string. if Test_String /= B10.To_Bounded_Wide_String(Translate("abc")) then Report.Failed("Incorrect result from Procedure Overwrite - 2"); end if; -- Drop = Error (Default). begin Test_String := AtoJ_Bnd_Str; B10.Overwrite(Source => Test_String, -- "abcdefghij" Position => 8, New_Item => Translate("uvwxyz")); Report.Failed("Exception not raised by Procedure Overwrite"); exception when AS.Length_Error => null; -- Expected exception raised. when others => Report.Failed("Incorrect exception raised by Procedure Overwrite"); end; -- Drop = Left Test_String := AtoJ_Bnd_Str; B10.Overwrite(Source => Test_String, -- "abcdefghij" Position => B10.Length(Test_String) - 2, -- 8 New_Item => Translate("uvwxyz"), Drop => Ada.Strings.Left); if B10.To_Wide_String(Test_String) /= Translate("defguvwxyz") then Report.Failed ("Incorrect result from Procedure Overwrite, Drop = Left"); end if; -- Drop = Right Test_String := AtoJ_Bnd_Str; B10.Overwrite(Test_String, -- "abcdefghij" 3, Translate("xxxyyyzzz"), Ada.Strings.Right); if B10.To_Wide_String(Test_String) /= Translate("abxxxyyyzz") then Report.Failed ("Incorrect result from Procedure Overwrite, Drop = Right"); end if; -- Function Delete if B10.Delete(Source => AtoJ_Bnd_Str, -- "abcdefghij" From => 3, Through => 8) /= B10."&"(B10.Head(AtoJ_Bnd_Str, 2), B10.Tail(AtoJ_Bnd_Str, 2)) or B10.Delete(AtoJ_Bnd_Str, 6, B10.Length(AtoJ_Bnd_Str)) /= AtoE_Bnd_Str or B10.Delete(AtoJ_Bnd_Str, 1, 5) /= FtoJ_Bnd_Str then Report.Failed("Incorrect result from Function Delete - 1"); end if; if B10.Delete(B10.To_Bounded_Wide_String(Translate("a")), 1, 1) /= B10.Null_Bounded_Wide_String or B10.Delete(AtoE_Bnd_Str, 5, B10.To_Wide_String(AtoE_Bnd_Str)'First) /= AtoE_Bnd_Str or B10.Delete(AtoE_Bnd_Str, B10.To_Wide_String(AtoE_Bnd_Str)'Last, B10.To_Wide_String(AtoE_Bnd_Str)'Last) /= B10.To_Bounded_Wide_String(Translate("abcd")) then Report.Failed("Incorrect result from Function Delete - 2"); end if; -- Function Trim declare Text : B10.Bounded_Wide_String := B10.To_Bounded_Wide_String(Translate("Text")); type Bnd_Array_Type is array (1..5) of B10.Bounded_Wide_String; Bnd_Array : Bnd_Array_Type := (B10.To_Bounded_Wide_String(Translate(" Text")), B10.To_Bounded_Wide_String(Translate("Text ")), B10.To_Bounded_Wide_String(Translate(" Text ")), B10.To_Bounded_Wide_String(Translate("Text Text")), B10.To_Bounded_Wide_String(Translate(" Text Text"))); begin for i in Bnd_Array_Type'Range loop case i is when 4 => if B10.Trim(Bnd_Array(i), AS.Both) /= Bnd_Array(i) then -- no change Report.Failed("Incorrect result from Function Trim - 4"); end if; when 5 => if B10.Trim(Bnd_Array(i), AS.Both) /= B10."&"(Text, B10."&"(Translate(' '), Text)) then Report.Failed("Incorrect result from Function Trim - 5"); end if; when others => if B10.Trim(Bnd_Array(i), AS.Both) /= Text then Report.Failed("Incorrect result from Function Trim - " & Integer'Image(i)); end if; end case; end loop; end; -- Function Trim using Sets -- Trim characters in sets from both sides of the bounded wide string. if B10.Trim(Source => B10.To_Bounded_Wide_String(Translate("ddabbaxx")), Left => CD_Set, Right => XY_Set) /= B10.To_Bounded_Wide_String(Translate("abba")) then Report.Failed ("Incorrect result from Fn Trim - Sets, Left & Right side - 1"); end if; -- Ensure that the characters in the set provided as the actual to -- parameter Right are not trimmed from the left side of the bounded -- wide string; likewise for the opposite side. Only "cd" trimmed -- from left side, and only "xy" trimmed from right side. if B10.Trim(B10.To_Bounded_Wide_String(Translate("cdxyabcdxy")), CD_Set, XY_Set) /= B10.To_Bounded_Wide_String(Translate("xyabcd")) then Report.Failed
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -