-- CXB3005.A
|
-- CXB3005.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- 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
|
-- 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 in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- 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
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- Check that the procedure To_C converts the character elements of
|
-- Check that the procedure To_C converts the character elements of
|
-- a string parameter into char elements of the char_array parameter
|
-- a string parameter into char elements of the char_array parameter
|
-- Target, with nul termination if parameter Append_Nul is true.
|
-- Target, with nul termination if parameter Append_Nul is true.
|
--
|
--
|
-- Check that the out parameter Count of procedure To_C is set to the
|
-- Check that the out parameter Count of procedure To_C is set to the
|
-- appropriate value for both the nul/no nul terminated cases.
|
-- appropriate value for both the nul/no nul terminated cases.
|
--
|
--
|
-- Check that Constraint_Error is propagated by procedure To_C if the
|
-- Check that Constraint_Error is propagated by procedure To_C if the
|
-- length of the char_array parameter Target is not sufficient to
|
-- length of the char_array parameter Target is not sufficient to
|
-- hold the converted string value.
|
-- hold the converted string value.
|
--
|
--
|
-- Check that the Procedure To_Ada converts char elements of the
|
-- Check that the Procedure To_Ada converts char elements of the
|
-- char_array parameter Item to the corresponding character elements
|
-- char_array parameter Item to the corresponding character elements
|
-- of string out parameter Target.
|
-- of string out parameter Target.
|
--
|
--
|
-- Check that Constraint_Error is propagated by Procedure To_Ada if the
|
-- Check that Constraint_Error is propagated by Procedure To_Ada if the
|
-- length of string parameter Target is not long enough to hold the
|
-- length of string parameter Target is not long enough to hold the
|
-- converted char_array value.
|
-- converted char_array value.
|
--
|
--
|
-- Check that Terminator_Error is propagated by Procedure To_Ada if the
|
-- Check that Terminator_Error is propagated by Procedure To_Ada if the
|
-- parameter Trim_Nul is set to True, but the actual Item parameter
|
-- parameter Trim_Nul is set to True, but the actual Item parameter
|
-- contains no nul char.
|
-- contains no nul char.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- This test uses a variety of String, and char_array objects to test
|
-- This test uses a variety of String, and char_array objects to test
|
-- versions of the To_C and To_Ada procedures.
|
-- versions of the To_C and To_Ada procedures.
|
--
|
--
|
-- This test assumes that the following characters are all included
|
-- This test assumes that the following characters are all included
|
-- in the implementation defined type Interfaces.C.char:
|
-- in the implementation defined type Interfaces.C.char:
|
-- ' ', 'a'..'z', 'A'..'Z', '0'..'9', and '-'.
|
-- ' ', 'a'..'z', 'A'..'Z', '0'..'9', and '-'.
|
--
|
--
|
-- APPLICABILITY CRITERIA:
|
-- APPLICABILITY CRITERIA:
|
-- This test is applicable to all implementations that provide
|
-- This test is applicable to all implementations that provide
|
-- package Interfaces.C. If an implementation provides
|
-- package Interfaces.C. If an implementation provides
|
-- package Interfaces.C, this test must compile, execute, and
|
-- package Interfaces.C, this test must compile, execute, and
|
-- report "PASSED".
|
-- report "PASSED".
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 01 Sep 95 SAIC Initial prerelease version.
|
-- 01 Sep 95 SAIC Initial prerelease version.
|
-- 09 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
|
-- 09 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
|
-- 26 Oct 96 SAIC Incorporated reviewer comments.
|
-- 26 Oct 96 SAIC Incorporated reviewer comments.
|
-- 14 Sep 99 RLB Removed incorrect and unnecessary
|
-- 14 Sep 99 RLB Removed incorrect and unnecessary
|
-- Unchecked_Conversion.
|
-- Unchecked_Conversion.
|
--
|
--
|
--!
|
--!
|
|
|
with Report;
|
with Report;
|
with Interfaces.C; -- N/A => ERROR
|
with Interfaces.C; -- N/A => ERROR
|
with Ada.Characters.Latin_1;
|
with Ada.Characters.Latin_1;
|
with Ada.Exceptions;
|
with Ada.Exceptions;
|
with Ada.Strings.Fixed;
|
with Ada.Strings.Fixed;
|
|
|
procedure CXB3005 is
|
procedure CXB3005 is
|
begin
|
begin
|
|
|
Report.Test ("CXB3005", "Check that the procedures To_C and To_Ada " &
|
Report.Test ("CXB3005", "Check that the procedures To_C and To_Ada " &
|
"produce correct results");
|
"produce correct results");
|
Test_Block:
|
Test_Block:
|
declare
|
declare
|
|
|
use Interfaces, Interfaces.C;
|
use Interfaces, Interfaces.C;
|
use Ada.Characters;
|
use Ada.Characters;
|
use Ada.Exceptions;
|
use Ada.Exceptions;
|
use Ada.Strings.Fixed;
|
use Ada.Strings.Fixed;
|
|
|
TC_Short_String : String(1..4) := (others => 'x');
|
TC_Short_String : String(1..4) := (others => 'x');
|
TC_String : String(1..8) := (others => 'y');
|
TC_String : String(1..8) := (others => 'y');
|
TC_char_array : char_array(0..7) := (others => char'Last);
|
TC_char_array : char_array(0..7) := (others => char'Last);
|
TC_size_t_Count : size_t := size_t'First;
|
TC_size_t_Count : size_t := size_t'First;
|
TC_Natural_Count : Natural := Natural'First;
|
TC_Natural_Count : Natural := Natural'First;
|
|
|
|
|
-- We can use the character forms of To_Ada and To_C here to check
|
-- We can use the character forms of To_Ada and To_C here to check
|
-- the results; they were tested in CXB3004. We give them different
|
-- the results; they were tested in CXB3004. We give them different
|
-- names to avoid confusion below.
|
-- names to avoid confusion below.
|
|
|
function Character_to_char (Source : in Character) return char
|
function Character_to_char (Source : in Character) return char
|
renames To_C;
|
renames To_C;
|
function char_to_Character (Source : in char) return Character
|
function char_to_Character (Source : in char) return Character
|
renames To_Ada;
|
renames To_Ada;
|
|
|
begin
|
begin
|
|
|
-- Check that the procedure To_C converts the character elements of
|
-- Check that the procedure To_C converts the character elements of
|
-- a string parameter into char elements of char_array out parameter
|
-- a string parameter into char elements of char_array out parameter
|
-- Target.
|
-- Target.
|
--
|
--
|
-- Case of nul termination.
|
-- Case of nul termination.
|
|
|
TC_String(1..6) := "abcdef";
|
TC_String(1..6) := "abcdef";
|
|
|
To_C (Item => TC_String(1..6), -- Source slice of length 6.
|
To_C (Item => TC_String(1..6), -- Source slice of length 6.
|
Target => TC_char_array, -- Length 8 will accommodate nul.
|
Target => TC_char_array, -- Length 8 will accommodate nul.
|
Count => TC_size_t_Count,
|
Count => TC_size_t_Count,
|
Append_Nul => True);
|
Append_Nul => True);
|
|
|
-- Check that the out parameter Count is set to the appropriate value
|
-- Check that the out parameter Count is set to the appropriate value
|
-- for the nul terminated case.
|
-- for the nul terminated case.
|
|
|
if TC_size_t_Count /= 7 then
|
if TC_size_t_Count /= 7 then
|
Report.Failed("Incorrect setting of out parameter Count by " &
|
Report.Failed("Incorrect setting of out parameter Count by " &
|
"Procedure To_C when Append_Nul => True");
|
"Procedure To_C when Append_Nul => True");
|
end if;
|
end if;
|
|
|
for i in 1..TC_size_t_Count-1 loop
|
for i in 1..TC_size_t_Count-1 loop
|
if char_to_Character(TC_char_array(i-1)) /= TC_String(Integer(i))
|
if char_to_Character(TC_char_array(i-1)) /= TC_String(Integer(i))
|
then
|
then
|
Report.Failed("Incorrect result from Procedure To_C when " &
|
Report.Failed("Incorrect result from Procedure To_C when " &
|
"checking individual char values, case of " &
|
"checking individual char values, case of " &
|
"Append_Nul => True; " &
|
"Append_Nul => True; " &
|
"char position = " & Integer'Image(Integer(i)));
|
"char position = " & Integer'Image(Integer(i)));
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
if not Is_Nul_Terminated(TC_char_array) then
|
if not Is_Nul_Terminated(TC_char_array) then
|
Report.Failed("No nul char appended to the char_array result " &
|
Report.Failed("No nul char appended to the char_array result " &
|
"from Procedure To_C when Append_Nul => True");
|
"from Procedure To_C when Append_Nul => True");
|
end if;
|
end if;
|
|
|
if TC_char_array(0..6) /= To_C("abcdef", True) then
|
if TC_char_array(0..6) /= To_C("abcdef", True) then
|
Report.Failed("Incorrect result from Procedure To_C when " &
|
Report.Failed("Incorrect result from Procedure To_C when " &
|
"directly comparing char_array results, case " &
|
"directly comparing char_array results, case " &
|
"of Append_Nul => True");
|
"of Append_Nul => True");
|
end if;
|
end if;
|
|
|
|
|
-- Check Procedure To_C with no nul termination.
|
-- Check Procedure To_C with no nul termination.
|
|
|
TC_char_array := (others => Character_to_char('M')); -- Reinitialize.
|
TC_char_array := (others => Character_to_char('M')); -- Reinitialize.
|
TC_String(1..4) := "WXYZ";
|
TC_String(1..4) := "WXYZ";
|
|
|
To_C (Item => TC_String(1..4), -- Source slice of length 4.
|
To_C (Item => TC_String(1..4), -- Source slice of length 4.
|
Target => TC_char_array,
|
Target => TC_char_array,
|
Count => TC_size_t_Count,
|
Count => TC_size_t_Count,
|
Append_Nul => False);
|
Append_Nul => False);
|
|
|
-- Check that the out parameter Count is set to the appropriate value
|
-- Check that the out parameter Count is set to the appropriate value
|
-- for the non-nul terminated case.
|
-- for the non-nul terminated case.
|
|
|
if TC_size_t_Count /= 4 then
|
if TC_size_t_Count /= 4 then
|
Report.Failed("Incorrect setting of out parameter Count by " &
|
Report.Failed("Incorrect setting of out parameter Count by " &
|
"Procedure To_C when Append_Nul => False");
|
"Procedure To_C when Append_Nul => False");
|
end if;
|
end if;
|
|
|
for i in 1..TC_size_t_Count loop
|
for i in 1..TC_size_t_Count loop
|
if char_to_Character(TC_char_array(i-1)) /= TC_String(Integer(i))
|
if char_to_Character(TC_char_array(i-1)) /= TC_String(Integer(i))
|
then
|
then
|
Report.Failed("Incorrect result from Procedure To_C when " &
|
Report.Failed("Incorrect result from Procedure To_C when " &
|
"checking individual char values, case of " &
|
"checking individual char values, case of " &
|
"Append_Nul => False; " &
|
"Append_Nul => False; " &
|
"char position = " & Integer'Image(Integer(i)));
|
"char position = " & Integer'Image(Integer(i)));
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
if Is_Nul_Terminated(TC_char_array) then
|
if Is_Nul_Terminated(TC_char_array) then
|
Report.Failed("The nul char was appended to the char_array " &
|
Report.Failed("The nul char was appended to the char_array " &
|
"result of Procedure To_C when Append_Nul => False");
|
"result of Procedure To_C when Append_Nul => False");
|
end if;
|
end if;
|
|
|
if TC_char_array(0..3) /= To_C("WXYZ", False) then
|
if TC_char_array(0..3) /= To_C("WXYZ", False) then
|
Report.Failed("Incorrect result from Procedure To_C when " &
|
Report.Failed("Incorrect result from Procedure To_C when " &
|
"directly comparing char_array results, case " &
|
"directly comparing char_array results, case " &
|
"of Append_Nul => False");
|
"of Append_Nul => False");
|
end if;
|
end if;
|
|
|
|
|
|
|
-- Check that Constraint_Error is raised by procedure To_C if the
|
-- Check that Constraint_Error is raised by procedure To_C if the
|
-- length of the target char_array parameter is not sufficient to
|
-- length of the target char_array parameter is not sufficient to
|
-- hold the converted string value (plus nul if Append_Nul is True).
|
-- hold the converted string value (plus nul if Append_Nul is True).
|
|
|
begin
|
begin
|
To_C("A string too long",
|
To_C("A string too long",
|
TC_char_array,
|
TC_char_array,
|
TC_size_t_Count,
|
TC_size_t_Count,
|
Append_Nul => True);
|
Append_Nul => True);
|
|
|
Report.Failed("Constraint_Error not raised when the Target " &
|
Report.Failed("Constraint_Error not raised when the Target " &
|
"parameter of Procedure To_C is not long enough " &
|
"parameter of Procedure To_C is not long enough " &
|
"to hold the converted string");
|
"to hold the converted string");
|
Report.Comment(char_to_Character(TC_char_array(0)) &
|
Report.Comment(char_to_Character(TC_char_array(0)) &
|
" printed to defeat optimization");
|
" printed to defeat optimization");
|
exception
|
exception
|
when Constraint_Error => null; -- OK, expected exception.
|
when Constraint_Error => null; -- OK, expected exception.
|
when others =>
|
when others =>
|
Report.Failed("Incorrect exception raised by Procedure " &
|
Report.Failed("Incorrect exception raised by Procedure " &
|
"To_C when the Target parameter is not long " &
|
"To_C when the Target parameter is not long " &
|
"enough to contain the char_array result");
|
"enough to contain the char_array result");
|
end;
|
end;
|
|
|
|
|
|
|
-- Check that the procedure To_Ada converts char elements of the
|
-- Check that the procedure To_Ada converts char elements of the
|
-- char_array parameter Item to the corresponding character elements
|
-- char_array parameter Item to the corresponding character elements
|
-- of string out parameter Target, with result string length based on
|
-- of string out parameter Target, with result string length based on
|
-- the Trim_Nul parameter.
|
-- the Trim_Nul parameter.
|
--
|
--
|
-- Case of appended nul char on the char_array In parameter.
|
-- Case of appended nul char on the char_array In parameter.
|
|
|
TC_char_array := To_C ("ACVC-95", Append_Nul => True); -- 8 total chars.
|
TC_char_array := To_C ("ACVC-95", Append_Nul => True); -- 8 total chars.
|
TC_String := (others => '*'); -- Reinitialize.
|
TC_String := (others => '*'); -- Reinitialize.
|
|
|
To_Ada (Item => TC_char_array,
|
To_Ada (Item => TC_char_array,
|
Target => TC_String,
|
Target => TC_String,
|
Count => TC_Natural_Count,
|
Count => TC_Natural_Count,
|
Trim_Nul => False);
|
Trim_Nul => False);
|
|
|
if TC_Natural_Count /= 8 then
|
if TC_Natural_Count /= 8 then
|
Report.Failed("Incorrect value returned in out parameter Count " &
|
Report.Failed("Incorrect value returned in out parameter Count " &
|
"by Procedure To_Ada, case of Trim_Nul => False");
|
"by Procedure To_Ada, case of Trim_Nul => False");
|
end if;
|
end if;
|
|
|
for i in 1..TC_Natural_Count loop
|
for i in 1..TC_Natural_Count loop
|
if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
|
if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
|
then
|
then
|
Report.Failed("Incorrect result from Procedure To_Ada when " &
|
Report.Failed("Incorrect result from Procedure To_Ada when " &
|
"checking individual char values, case of " &
|
"checking individual char values, case of " &
|
"Trim_Nul => False, when a nul is present in " &
|
"Trim_Nul => False, when a nul is present in " &
|
"the char_array input parameter; " &
|
"the char_array input parameter; " &
|
"position = " & Integer'Image(Integer(i)));
|
"position = " & Integer'Image(Integer(i)));
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
if TC_String(TC_Natural_Count) /= Latin_1.Nul then
|
if TC_String(TC_Natural_Count) /= Latin_1.Nul then
|
Report.Failed("Last character of String result of Procedure " &
|
Report.Failed("Last character of String result of Procedure " &
|
"To_Ada is not Nul, even though a nul was present " &
|
"To_Ada is not Nul, even though a nul was present " &
|
"in the char_array argument, and the Trim_Nul " &
|
"in the char_array argument, and the Trim_Nul " &
|
"parameter was set to False");
|
"parameter was set to False");
|
end if;
|
end if;
|
|
|
|
|
TC_char_array(0..3) := To_C ("XYz", Append_Nul => True); -- 4 chars.
|
TC_char_array(0..3) := To_C ("XYz", Append_Nul => True); -- 4 chars.
|
TC_String := (others => '*'); -- Reinit.
|
TC_String := (others => '*'); -- Reinit.
|
|
|
To_Ada (Item => TC_char_array,
|
To_Ada (Item => TC_char_array,
|
Target => TC_String,
|
Target => TC_String,
|
Count => TC_Natural_Count,
|
Count => TC_Natural_Count,
|
Trim_Nul => True);
|
Trim_Nul => True);
|
|
|
if TC_Natural_Count /= 3 then
|
if TC_Natural_Count /= 3 then
|
Report.Failed("Incorrect value returned in out parameter Count " &
|
Report.Failed("Incorrect value returned in out parameter Count " &
|
"by Procedure To_Ada, case of Trim_Nul => True");
|
"by Procedure To_Ada, case of Trim_Nul => True");
|
end if;
|
end if;
|
|
|
for i in 1..TC_Natural_Count loop
|
for i in 1..TC_Natural_Count loop
|
if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
|
if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
|
then
|
then
|
Report.Failed("Incorrect result from Procedure To_Ada when " &
|
Report.Failed("Incorrect result from Procedure To_Ada when " &
|
"checking individual char values, case of " &
|
"checking individual char values, case of " &
|
"Trim_Nul => True, when a nul is present in " &
|
"Trim_Nul => True, when a nul is present in " &
|
"the char_array input parameter; " &
|
"the char_array input parameter; " &
|
"position = " & Integer'Image(Integer(i)));
|
"position = " & Integer'Image(Integer(i)));
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
if TC_String(TC_Natural_Count) = Latin_1.Nul then
|
if TC_String(TC_Natural_Count) = Latin_1.Nul then
|
Report.Failed("Last character of String result of Procedure " &
|
Report.Failed("Last character of String result of Procedure " &
|
"To_Ada is Nul, even though the Trim_Nul " &
|
"To_Ada is Nul, even though the Trim_Nul " &
|
"parameter was set to True");
|
"parameter was set to True");
|
end if;
|
end if;
|
|
|
-- Check that TC_String(TC_Natural_Count+1) is unchanged by procedure
|
-- Check that TC_String(TC_Natural_Count+1) is unchanged by procedure
|
-- To_Ada.
|
-- To_Ada.
|
|
|
if TC_String(TC_Natural_Count+1) /= '*' then
|
if TC_String(TC_Natural_Count+1) /= '*' then
|
Report.Failed("Incorrect modification to TC_String at position " &
|
Report.Failed("Incorrect modification to TC_String at position " &
|
Integer'Image(TC_Natural_Count+1) & " expected = " &
|
Integer'Image(TC_Natural_Count+1) & " expected = " &
|
"*, found = " & TC_String(TC_Natural_Count+1));
|
"*, found = " & TC_String(TC_Natural_Count+1));
|
end if;
|
end if;
|
|
|
|
|
-- Case of no nul char being present in the char_array argument.
|
-- Case of no nul char being present in the char_array argument.
|
|
|
TC_char_array := To_C ("ABCDWXYZ", Append_Nul => False);
|
TC_char_array := To_C ("ABCDWXYZ", Append_Nul => False);
|
TC_String := (others => '*'); -- Reinitialize.
|
TC_String := (others => '*'); -- Reinitialize.
|
|
|
To_Ada (Item => TC_char_array,
|
To_Ada (Item => TC_char_array,
|
Target => TC_String,
|
Target => TC_String,
|
Count => TC_Natural_Count,
|
Count => TC_Natural_Count,
|
Trim_Nul => False);
|
Trim_Nul => False);
|
|
|
if TC_Natural_Count /= 8 then
|
if TC_Natural_Count /= 8 then
|
Report.Failed("Incorrect value returned in out parameter Count " &
|
Report.Failed("Incorrect value returned in out parameter Count " &
|
"by Procedure To_Ada, case of Trim_Nul => False, " &
|
"by Procedure To_Ada, case of Trim_Nul => False, " &
|
"with no nul char present in the parameter Item");
|
"with no nul char present in the parameter Item");
|
end if;
|
end if;
|
|
|
for i in 1..TC_Natural_Count loop
|
for i in 1..TC_Natural_Count loop
|
if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
|
if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
|
then
|
then
|
Report.Failed("Incorrect result from Procedure To_Ada when " &
|
Report.Failed("Incorrect result from Procedure To_Ada when " &
|
"checking individual char values, case of " &
|
"checking individual char values, case of " &
|
"Trim_Nul => False, when a nul is not present " &
|
"Trim_Nul => False, when a nul is not present " &
|
"in the char_array input parameter; " &
|
"in the char_array input parameter; " &
|
"position = " & Integer'Image(Integer(i)));
|
"position = " & Integer'Image(Integer(i)));
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
if TC_String(TC_Natural_Count) = Latin_1.Nul then
|
if TC_String(TC_Natural_Count) = Latin_1.Nul then
|
Report.Failed("Last character of String result of Procedure " &
|
Report.Failed("Last character of String result of Procedure " &
|
"To_Ada is Nul, even though the nul char was " &
|
"To_Ada is Nul, even though the nul char was " &
|
"not present in the parameter Item, with the " &
|
"not present in the parameter Item, with the " &
|
"parameter Trim_Nul => False");
|
"parameter Trim_Nul => False");
|
end if;
|
end if;
|
|
|
|
|
|
|
-- Check that the Procedure To_Ada raises Terminator_Error if the
|
-- Check that the Procedure To_Ada raises Terminator_Error if the
|
-- parameter Trim_Nul is set to True, but the actual Item parameter
|
-- parameter Trim_Nul is set to True, but the actual Item parameter
|
-- does not contain the nul char.
|
-- does not contain the nul char.
|
|
|
begin
|
begin
|
TC_char_array := To_C ("ABCDWXYZ", Append_Nul => False);
|
TC_char_array := To_C ("ABCDWXYZ", Append_Nul => False);
|
TC_String := (others => '*');
|
TC_String := (others => '*');
|
|
|
To_Ada(TC_char_array,
|
To_Ada(TC_char_array,
|
TC_String,
|
TC_String,
|
Count => TC_Natural_Count,
|
Count => TC_Natural_Count,
|
Trim_Nul => True);
|
Trim_Nul => True);
|
|
|
Report.Failed("Terminator_Error not raised when Item " &
|
Report.Failed("Terminator_Error not raised when Item " &
|
"parameter of To_Ada does not contain the " &
|
"parameter of To_Ada does not contain the " &
|
"nul char, but parameter Trim_Nul => True");
|
"nul char, but parameter Trim_Nul => True");
|
Report.Comment(TC_String & " printed to defeat optimization");
|
Report.Comment(TC_String & " printed to defeat optimization");
|
exception
|
exception
|
when Terminator_Error => null; -- OK, expected exception.
|
when Terminator_Error => null; -- OK, expected exception.
|
when others =>
|
when others =>
|
Report.Failed("Incorrect exception raised by Procedure " &
|
Report.Failed("Incorrect exception raised by Procedure " &
|
"To_Ada when the Item parameter does not " &
|
"To_Ada when the Item parameter does not " &
|
"contain the nul char, but parameter " &
|
"contain the nul char, but parameter " &
|
"Trim_Nul => True");
|
"Trim_Nul => True");
|
end;
|
end;
|
|
|
|
|
|
|
-- Check that Constraint_Error is propagated by procedure To_Ada if the
|
-- Check that Constraint_Error is propagated by procedure To_Ada if the
|
-- length of string parameter Target is not long enough to hold the
|
-- length of string parameter Target is not long enough to hold the
|
-- converted char_array value (plus nul if Trim_Nul is False).
|
-- converted char_array value (plus nul if Trim_Nul is False).
|
|
|
begin
|
begin
|
TC_char_array(0..4) := To_C ("ABCD", Append_Nul => True);
|
TC_char_array(0..4) := To_C ("ABCD", Append_Nul => True);
|
|
|
To_Ada(TC_char_array(0..4), -- 4 chars plus nul char.
|
To_Ada(TC_char_array(0..4), -- 4 chars plus nul char.
|
TC_Short_String, -- Length of 4.
|
TC_Short_String, -- Length of 4.
|
Count => TC_Natural_Count,
|
Count => TC_Natural_Count,
|
Trim_Nul => False);
|
Trim_Nul => False);
|
|
|
Report.Failed("Constraint_Error not raised when string " &
|
Report.Failed("Constraint_Error not raised when string " &
|
"parameter Target of Procedure To_Ada is not " &
|
"parameter Target of Procedure To_Ada is not " &
|
"long enough to hold the converted chars");
|
"long enough to hold the converted chars");
|
Report.Comment(TC_Short_String & " printed to defeat optimization");
|
Report.Comment(TC_Short_String & " printed to defeat optimization");
|
exception
|
exception
|
when Constraint_Error => null; -- OK, expected exception.
|
when Constraint_Error => null; -- OK, expected exception.
|
when others =>
|
when others =>
|
Report.Failed("Incorrect exception raised by Procedure " &
|
Report.Failed("Incorrect exception raised by Procedure " &
|
"To_Ada when string parameter Target is " &
|
"To_Ada when string parameter Target is " &
|
"not long enough to hold the converted chars");
|
"not long enough to hold the converted chars");
|
end;
|
end;
|
|
|
|
|
|
|
exception
|
exception
|
when The_Error : others =>
|
when The_Error : others =>
|
Report.Failed ("The following exception was raised in the " &
|
Report.Failed ("The following exception was raised in the " &
|
"Test_Block: " & Exception_Name(The_Error));
|
"Test_Block: " & Exception_Name(The_Error));
|
end Test_Block;
|
end Test_Block;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end CXB3005;
|
end CXB3005;
|
|
|