summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/cxb/cxb3005.a
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/ada/acats/tests/cxb/cxb3005.a
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
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.
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxb/cxb3005.a')
-rw-r--r--gcc/testsuite/ada/acats/tests/cxb/cxb3005.a396
1 files changed, 396 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxb/cxb3005.a b/gcc/testsuite/ada/acats/tests/cxb/cxb3005.a
new file mode 100644
index 000000000..30b940535
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/cxb/cxb3005.a
@@ -0,0 +1,396 @@
+-- CXB3005.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 character elements of
+-- a string parameter into char elements of the char_array parameter
+-- Target, with 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 nul/no nul terminated cases.
+--
+-- Check that Constraint_Error is propagated by procedure To_C if the
+-- length of the char_array parameter Target is not sufficient to
+-- hold the converted string value.
+--
+-- Check that the Procedure To_Ada converts char elements of the
+-- char_array parameter Item to the corresponding character elements
+-- of string out parameter Target.
+--
+-- Check that Constraint_Error is propagated by Procedure To_Ada if the
+-- length of string parameter Target is not long enough to hold the
+-- converted char_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 nul char.
+--
+-- TEST DESCRIPTION:
+-- This test uses a variety of String, and char_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.char:
+-- ' ', 'a'..'z', 'A'..'Z', '0'..'9', 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.Exceptions;
+with Ada.Strings.Fixed;
+
+procedure CXB3005 is
+begin
+
+ Report.Test ("CXB3005", "Check that the procedures To_C and To_Ada " &
+ "produce correct results");
+ Test_Block:
+ declare
+
+ use Interfaces, Interfaces.C;
+ use Ada.Characters;
+ use Ada.Exceptions;
+ use Ada.Strings.Fixed;
+
+ TC_Short_String : String(1..4) := (others => 'x');
+ TC_String : String(1..8) := (others => 'y');
+ TC_char_array : char_array(0..7) := (others => char'Last);
+ TC_size_t_Count : size_t := size_t'First;
+ TC_Natural_Count : Natural := Natural'First;
+
+
+ -- 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
+ -- names to avoid confusion below.
+
+ function Character_to_char (Source : in Character) return char
+ renames To_C;
+ function char_to_Character (Source : in char) return Character
+ renames To_Ada;
+
+ begin
+
+ -- Check that the procedure To_C converts the character elements of
+ -- a string parameter into char elements of char_array out parameter
+ -- Target.
+ --
+ -- Case of nul termination.
+
+ TC_String(1..6) := "abcdef";
+
+ To_C (Item => TC_String(1..6), -- Source slice of length 6.
+ Target => TC_char_array, -- Length 8 will accommodate nul.
+ Count => TC_size_t_Count,
+ Append_Nul => True);
+
+ -- Check that the out parameter Count is set to the appropriate value
+ -- for the 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 char_to_Character(TC_char_array(i-1)) /= TC_String(Integer(i))
+ then
+ Report.Failed("Incorrect result from Procedure To_C when " &
+ "checking individual char values, case of " &
+ "Append_Nul => True; " &
+ "char position = " & Integer'Image(Integer(i)));
+ end if;
+ end loop;
+
+ if not Is_Nul_Terminated(TC_char_array) then
+ Report.Failed("No nul char appended to the char_array result " &
+ "from Procedure To_C when Append_Nul => True");
+ end if;
+
+ if TC_char_array(0..6) /= To_C("abcdef", True) then
+ Report.Failed("Incorrect result from Procedure To_C when " &
+ "directly comparing char_array results, case " &
+ "of Append_Nul => True");
+ end if;
+
+
+ -- Check Procedure To_C with no nul termination.
+
+ TC_char_array := (others => Character_to_char('M')); -- Reinitialize.
+ TC_String(1..4) := "WXYZ";
+
+ To_C (Item => TC_String(1..4), -- Source slice of length 4.
+ Target => TC_char_array,
+ Count => TC_size_t_Count,
+ Append_Nul => False);
+
+ -- Check that the out parameter Count is set to the appropriate value
+ -- for the non-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 char_to_Character(TC_char_array(i-1)) /= TC_String(Integer(i))
+ then
+ Report.Failed("Incorrect result from Procedure To_C when " &
+ "checking individual char values, case of " &
+ "Append_Nul => False; " &
+ "char position = " & Integer'Image(Integer(i)));
+ end if;
+ end loop;
+
+ if Is_Nul_Terminated(TC_char_array) then
+ Report.Failed("The nul char was appended to the char_array " &
+ "result of Procedure To_C when Append_Nul => False");
+ end if;
+
+ if TC_char_array(0..3) /= To_C("WXYZ", False) then
+ Report.Failed("Incorrect result from Procedure To_C when " &
+ "directly comparing char_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 char_array parameter is not sufficient to
+ -- hold the converted string value (plus nul if Append_Nul is True).
+
+ begin
+ To_C("A string too long",
+ TC_char_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 string");
+ Report.Comment(char_to_Character(TC_char_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 char_array result");
+ end;
+
+
+
+ -- Check that the procedure To_Ada converts char elements of the
+ -- char_array parameter Item to the corresponding character elements
+ -- of string out parameter Target, with result string length based on
+ -- the Trim_Nul 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_String := (others => '*'); -- Reinitialize.
+
+ To_Ada (Item => TC_char_array,
+ Target => TC_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 Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
+ then
+ Report.Failed("Incorrect result from Procedure To_Ada when " &
+ "checking individual char values, case of " &
+ "Trim_Nul => False, when a nul is present in " &
+ "the char_array input parameter; " &
+ "position = " & Integer'Image(Integer(i)));
+ end if;
+ end loop;
+
+ if TC_String(TC_Natural_Count) /= Latin_1.Nul then
+ Report.Failed("Last character of String result of Procedure " &
+ "To_Ada is not Nul, even though a nul was present " &
+ "in the char_array argument, and the Trim_Nul " &
+ "parameter was set to False");
+ end if;
+
+
+ TC_char_array(0..3) := To_C ("XYz", Append_Nul => True); -- 4 chars.
+ TC_String := (others => '*'); -- Reinit.
+
+ To_Ada (Item => TC_char_array,
+ Target => TC_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 Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
+ then
+ Report.Failed("Incorrect result from Procedure To_Ada when " &
+ "checking individual char values, case of " &
+ "Trim_Nul => True, when a nul is present in " &
+ "the char_array input parameter; " &
+ "position = " & Integer'Image(Integer(i)));
+ end if;
+ end loop;
+
+ if TC_String(TC_Natural_Count) = Latin_1.Nul then
+ Report.Failed("Last character of String result of Procedure " &
+ "To_Ada is Nul, even though the Trim_Nul " &
+ "parameter was set to True");
+ end if;
+
+ -- Check that TC_String(TC_Natural_Count+1) is unchanged by procedure
+ -- To_Ada.
+
+ if TC_String(TC_Natural_Count+1) /= '*' then
+ Report.Failed("Incorrect modification to TC_String at position " &
+ Integer'Image(TC_Natural_Count+1) & " expected = " &
+ "*, found = " & TC_String(TC_Natural_Count+1));
+ end if;
+
+
+ -- Case of no nul char being present in the char_array argument.
+
+ TC_char_array := To_C ("ABCDWXYZ", Append_Nul => False);
+ TC_String := (others => '*'); -- Reinitialize.
+
+ To_Ada (Item => TC_char_array,
+ Target => TC_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 nul char present in the parameter Item");
+ end if;
+
+ for i in 1..TC_Natural_Count loop
+ if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
+ then
+ Report.Failed("Incorrect result from Procedure To_Ada when " &
+ "checking individual char values, case of " &
+ "Trim_Nul => False, when a nul is not present " &
+ "in the char_array input parameter; " &
+ "position = " & Integer'Image(Integer(i)));
+ end if;
+ end loop;
+
+ if TC_String(TC_Natural_Count) = Latin_1.Nul then
+ Report.Failed("Last character of String result of Procedure " &
+ "To_Ada is Nul, even though the nul char 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 nul char.
+
+ begin
+ TC_char_array := To_C ("ABCDWXYZ", Append_Nul => False);
+ TC_String := (others => '*');
+
+ To_Ada(TC_char_array,
+ TC_String,
+ Count => TC_Natural_Count,
+ Trim_Nul => True);
+
+ Report.Failed("Terminator_Error not raised when Item " &
+ "parameter of To_Ada does not contain the " &
+ "nul char, but parameter Trim_Nul => True");
+ Report.Comment(TC_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 nul char, but parameter " &
+ "Trim_Nul => True");
+ end;
+
+
+
+ -- Check that Constraint_Error is propagated by procedure To_Ada if the
+ -- length of string parameter Target is not long enough to hold the
+ -- converted char_array value (plus nul if Trim_Nul is False).
+
+ begin
+ TC_char_array(0..4) := To_C ("ABCD", Append_Nul => True);
+
+ To_Ada(TC_char_array(0..4), -- 4 chars plus nul char.
+ TC_Short_String, -- Length of 4.
+ Count => TC_Natural_Count,
+ Trim_Nul => False);
+
+ Report.Failed("Constraint_Error not raised when string " &
+ "parameter Target of Procedure To_Ada is not " &
+ "long enough to hold the converted chars");
+ Report.Comment(TC_Short_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 string parameter Target is " &
+ "not long enough to hold the converted chars");
+ 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 CXB3005;