URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxb/] [cxb3007.a] - Rev 827
Go to most recent revision | Compare with Previous | Blame | View Log
-- CXB3007.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 procedure To_C converts the Wide_Character elements
-- of a Wide_String parameter into wchar_t elements of the wchar_array
-- parameter Target, with wide_nul termination if parameter Append_Nul
-- is true.
--
-- Check that the out parameter Count of procedure To_C is set to the
-- appropriate value for both the wide_nul/no wide_nul terminated cases.
--
-- Check that Constraint_Error is propagated by procedure To_C if the
-- length of the wchar_array parameter Target is not sufficient to
-- hold the converted Wide_String value.
--
-- Check that the Procedure To_Ada converts wchar_t elements of the
-- wchar_array parameter Item to the corresponding Wide_Character
-- elements of Wide_String out parameter Target.
--
-- Check that Constraint_Error is propagated by Procedure To_Ada if the
-- length of Wide_String parameter Target is not long enough to hold the
-- converted wchar_array value.
--
-- Check that Terminator_Error is propagated by Procedure To_Ada if the
-- parameter Trim_Nul is set to True, but the actual Item parameter
-- contains no wide_nul wchar_t.
--
-- TEST DESCRIPTION:
-- This test uses a variety of Wide_String, and wchar_array objects to
-- test versions of the To_C and To_Ada procedures.
--
-- This test assumes that the following characters are all included
-- in the implementation defined type Interfaces.C.wchar_t:
-- ' ', 'a'..'z', 'A'..'Z', and '-'.
--
-- APPLICABILITY CRITERIA:
-- This test is applicable to all implementations that provide
-- package Interfaces.C. If an implementation provides
-- package Interfaces.C, this test must compile, execute, and
-- report "PASSED".
--
-- CHANGE HISTORY:
-- 01 Sep 95 SAIC Initial prerelease version.
-- 09 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
-- 26 Oct 96 SAIC Incorporated reviewer comments.
-- 14 Sep 99 RLB Removed incorrect and unnecessary
-- Unchecked_Conversion.
--
--!
with Report;
with Interfaces.C; -- N/A => ERROR
with Ada.Characters.Latin_1;
with Ada.Characters.Handling;
with Ada.Exceptions;
with Ada.Strings.Wide_Fixed;
procedure CXB3007 is
begin
Report.Test ("CXB3007", "Check that the procedures To_C and To_Ada " &
"for wide strings produce correct results");
Test_Block:
declare
use Interfaces, Interfaces.C;
use Ada.Characters, Ada.Characters.Handling;
use Ada.Exceptions;
use Ada.Strings.Wide_Fixed;
TC_Short_Wide_String : Wide_String(1..4) :=
(others => Wide_Character'First);
TC_Wide_String : Wide_String(1..8) :=
(others => Wide_Character'First);
TC_wchar_array : wchar_array(0..7) := (others => wchar_t'First);
TC_size_t_Count : size_t := size_t'First;
TC_Natural_Count : Natural := Natural'First;
-- We can use the wide character forms of To_Ada and To_C here to check
-- the results; they were tested in CXB3006. We give them different
-- names to avoid confusion below.
function Wide_Character_to_wchar_t (Source : in Wide_Character)
return wchar_t renames To_C;
function wchar_t_to_Wide_Character (Source : in wchar_t)
return Wide_Character renames To_Ada;
begin
-- Check that the procedure To_C converts the Wide_Character elements
-- of a Wide_String parameter into wchar_t elements of wchar_array out
-- parameter Target.
--
-- Case of wide_nul termination.
TC_Wide_String(1..6) := "abcdef";
To_C (Item => TC_Wide_String(1..6), -- Source slice of length 6.
Target => TC_wchar_array,
Count => TC_size_t_Count,
Append_Nul => True);
-- Check that the out parameter Count is set to the appropriate value
-- for the wide_nul terminated case.
if TC_size_t_Count /= 7 then
Report.Failed("Incorrect setting of out parameter Count by " &
"Procedure To_C when Append_Nul => True");
end if;
for i in 1..TC_size_t_Count-1 loop
if wchar_t_to_Wide_Character(TC_wchar_array(i-1)) /=
TC_Wide_String(Integer(i))
then
Report.Failed("Incorrect result from Procedure To_C when " &
"checking individual wchar_t values, case of " &
"Append_Nul => True; " &
"wchar_t position = " & Integer'Image(Integer(i)));
end if;
end loop;
if not Is_Nul_Terminated(TC_wchar_array) then
Report.Failed("No wide_nul wchar_t appended to the wchar_array " &
"result from Procedure To_C when Append_Nul => True");
end if;
if TC_wchar_array(0..6) /= To_C("abcdef", True) then
Report.Failed("Incorrect result from Procedure To_C when " &
"directly comparing wchar_array results, case " &
"of Append_Nul => True");
end if;
-- Check Procedure To_C with no wide_nul termination.
TC_wchar_array := (others => Wide_Character_to_wchar_t('M'));
TC_Wide_String(1..4) := "WXYZ";
To_C (Item => TC_Wide_String(1..4), -- Source slice of length 4.
Target => TC_wchar_array,
Count => TC_size_t_Count,
Append_Nul => False);
-- Check that the out parameter Count is set to the appropriate value
-- for the non-wide_nul terminated case.
if TC_size_t_Count /= 4 then
Report.Failed("Incorrect setting of out parameter Count by " &
"Procedure To_C when Append_Nul => False");
end if;
for i in 1..TC_size_t_Count loop
if wchar_t_to_Wide_Character(TC_wchar_array(i-1)) /=
TC_Wide_String(Integer(i))
then
Report.Failed("Incorrect result from Procedure To_C when " &
"checking individual wchar_t values, case of " &
"Append_Nul => False; " &
"wchar_t position = " & Integer'Image(Integer(i)));
end if;
end loop;
if Is_Nul_Terminated(TC_wchar_array) then
Report.Failed
("The wide_nul wchar_t was appended to the wchar_array " &
"result of Procedure To_C when Append_Nul => False");
end if;
if TC_wchar_array(0..3) /= To_C("WXYZ", False) then
Report.Failed("Incorrect result from Procedure To_C when " &
"directly comparing wchar_array results, case " &
"of Append_Nul => False");
end if;
-- Check that Constraint_Error is raised by procedure To_C if the
-- length of the target wchar_array parameter is not sufficient to
-- hold the converted Wide_String value (plus wide_nul if Append_Nul
-- is True).
TC_wchar_array := (others => wchar_t'First);
begin
To_C("A string too long",
TC_wchar_array,
TC_size_t_Count,
Append_Nul => True);
Report.Failed("Constraint_Error not raised when the Target " &
"parameter of Procedure To_C is not long enough " &
"to hold the converted Wide_String");
Report.Comment
(To_Character(wchar_t_to_Wide_Character(TC_wchar_array(0))) &
" printed to defeat optimization");
exception
when Constraint_Error => null; -- OK, expected exception.
when others =>
Report.Failed("Incorrect exception raised by Procedure " &
"To_C when the Target parameter is not long " &
"enough to contain the wchar_array result");
end;
-- Check that the procedure To_Ada converts wchar_t elements of the
-- wchar_array parameter Item to the corresponding Wide_Character
-- elements of Wide_String out parameter Target, with result wide
-- string length based on the Trim_Nul parameter.
--
-- Case of appended wide_nul wchar_t on the wchar_array In parameter.
TC_wchar_array :=
To_C ("ACVC-95", Append_Nul => True); -- 8 total chars.
To_Ada (Item => TC_wchar_array,
Target => TC_Wide_String,
Count => TC_Natural_Count,
Trim_Nul => False);
if TC_Natural_Count /= 8 then
Report.Failed("Incorrect value returned in out parameter Count " &
"by Procedure To_Ada, case of Trim_Nul => False");
end if;
for i in 1..TC_Natural_Count loop
if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
TC_wchar_array(size_t(i-1))
then
Report.Failed("Incorrect result from Procedure To_Ada when " &
"checking individual wchar_t values, case of " &
"Trim_Nul => False, when a wide_nul is present " &
"in the wchar_array input parameter; " &
"position = " & Integer'Image(Integer(i)));
end if;
end loop;
if TC_Wide_String(TC_Natural_Count) /= To_Wide_Character(Latin_1.Nul)
then
Report.Failed("Last Wide_Character of Wide_String result of " &
"Procedure To_Ada is not Nul, even though a " &
"wide_nul was present in the wchar_array argument, " &
"and the Trim_Nul parameter was set to False");
end if;
TC_Wide_String := (others => Wide_Character'First);
TC_wchar_array(0..3) := To_C ("XYz", Append_Nul => True); -- 4 chars.
To_Ada (Item => TC_wchar_array,
Target => TC_Wide_String,
Count => TC_Natural_Count,
Trim_Nul => True);
if TC_Natural_Count /= 3 then
Report.Failed("Incorrect value returned in out parameter Count " &
"by Procedure To_Ada, case of Trim_Nul => True");
end if;
for i in 1..TC_Natural_Count loop
if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
TC_wchar_array(size_t(i-1))
then
Report.Failed("Incorrect result from Procedure To_Ada when " &
"checking individual wchar_t values, case of " &
"Trim_Nul => True, when a wide_nul is present " &
"in the wchar_array input parameter; " &
"position = " & Integer'Image(Integer(i)));
end if;
end loop;
if TC_Wide_String(TC_Natural_Count) = To_Wide_Character(Latin_1.Nul)
then
Report.Failed("Last Wide_Character of Wide_String result of " &
"Procedure To_Ada is Nul, even though the " &
"Trim_Nul parameter was set to True");
end if;
if TC_Wide_String(TC_Natural_Count+1) /= Wide_Character'First then
Report.Failed("Incorrect replacement from To_Ada");
end if;
-- Case of no wide_nul wchar_t present in the wchar_array argument.
TC_Wide_String := (others => Wide_Character'First);
TC_wchar_array := To_C ("ABCDWXYZ", Append_Nul => False);
To_Ada (Item => TC_wchar_array,
Target => TC_Wide_String,
Count => TC_Natural_Count,
Trim_Nul => False);
if TC_Natural_Count /= 8 then
Report.Failed("Incorrect value returned in out parameter Count " &
"by Procedure To_Ada, case of Trim_Nul => False, " &
"with no wide_nul wchar_t present in the parameter " &
"Item");
end if;
for i in 1..TC_Natural_Count loop
if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
TC_wchar_array(size_t(i-1))
then
Report.Failed("Incorrect result from Procedure To_Ada when " &
"checking individual wchar_t values, case of " &
"Trim_Nul => False, when a wide_nul is not " &
"present in the wchar_array input parameter; " &
"position = " & Integer'Image(Integer(i)));
end if;
end loop;
if TC_Wide_String(TC_Natural_Count) = To_Wide_Character(Latin_1.Nul)
then
Report.Failed("Last Wide_Character of Wide_String result of " &
"Procedure To_Ada is Nul, even though the wide_nul " &
"wchar_t was not present in the parameter Item, " &
"with the parameter Trim_Nul => False");
end if;
-- Check that the Procedure To_Ada raises Terminator_Error if the
-- parameter Trim_Nul is set to True, but the actual Item parameter
-- does not contain the wide_nul wchar_t.
begin
TC_Wide_String := (others => Wide_Character'First);
TC_wchar_array := To_C ("ABCDWXYZ", Append_Nul => False);
To_Ada(TC_wchar_array,
TC_Wide_String,
Count => TC_Natural_Count,
Trim_Nul => True);
Report.Failed("Terminator_Error not raised when Item " &
"parameter of To_Ada does not contain the " &
"wide_nul wchar_t, but parameter Trim_Nul => True");
Report.Comment(To_String(TC_Wide_String) &
" printed to defeat optimization");
exception
when Terminator_Error => null; -- OK, expected exception.
when others =>
Report.Failed("Incorrect exception raised by Procedure " &
"To_Ada when the Item parameter does not " &
"contain the wide_nul wchar_t, but parameter " &
"Trim_Nul => True");
end;
-- Check that Constraint_Error is propagated by procedure To_Ada if the
-- length of Wide_String parameter Target is not long enough to hold the
-- converted wchar_array value (plus wide_nul if Trim_Nul is False).
begin
TC_wchar_array(0..4) := To_C ("ABCD", Append_Nul => True);
To_Ada(TC_wchar_array(0..4),
TC_Short_Wide_String, -- Length of 4.
Count => TC_Natural_Count,
Trim_Nul => False);
Report.Failed("Constraint_Error not raised when Wide_String " &
"parameter Target of Procedure To_Ada is not " &
"long enough to hold the converted wchar_ts");
Report.Comment(To_String(TC_Short_Wide_String) &
" printed to defeat optimization");
exception
when Constraint_Error => null; -- OK, expected exception.
when others =>
Report.Failed("Incorrect exception raised by Procedure " &
"To_Ada when Wide_String parameter Target is " &
"not long enough to hold the converted wchar_ts");
end;
exception
when The_Error : others =>
Report.Failed ("The following exception was raised in the " &
"Test_Block: " & Exception_Name(The_Error));
end Test_Block;
Report.Result;
end CXB3007;
Go to most recent revision | Compare with Previous | Blame | View Log