-- CXB3014.A
|
-- CXB3014.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 Function Value with Pointer and Element
|
-- Check that the Function Value with Pointer and Element
|
-- parameters will return an Element_Array result of correct size
|
-- parameters will return an Element_Array result of correct size
|
-- and content (up to and including the first "terminator" Element).
|
-- and content (up to and including the first "terminator" Element).
|
--
|
--
|
-- Check that the Function Value with Pointer and Length parameters
|
-- Check that the Function Value with Pointer and Length parameters
|
-- will return an Element_Array result of appropriate size and content
|
-- will return an Element_Array result of appropriate size and content
|
-- (the first Length elements pointed to by the parameter Ref).
|
-- (the first Length elements pointed to by the parameter Ref).
|
--
|
--
|
-- Check that both versions of Function Value will propagate
|
-- Check that both versions of Function Value will propagate
|
-- Interfaces.C.Strings.Dereference_Error when the value of
|
-- Interfaces.C.Strings.Dereference_Error when the value of
|
-- the Ref pointer parameter is null.
|
-- the Ref pointer parameter is null.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- This test tests that both versions of Function Value from the
|
-- This test tests that both versions of Function Value from the
|
-- generic package Interfaces.C.Pointers are available and produce
|
-- generic package Interfaces.C.Pointers are available and produce
|
-- correct results. The generic package is instantiated with size_t,
|
-- correct results. The generic package is instantiated with size_t,
|
-- char, char_array, and nul as actual parameters, and subtests are
|
-- char, char_array, and nul as actual parameters, and subtests are
|
-- performed on each of the Value functions resulting from this
|
-- performed on each of the Value functions resulting from this
|
-- instantiation.
|
-- instantiation.
|
-- For both function versions, a test is performed where a portion of
|
-- For both function versions, a test is performed where a portion of
|
-- a char_array is to be returned as the function result. Likewise,
|
-- a char_array is to be returned as the function result. Likewise,
|
-- a test is performed where each version of the function returns the
|
-- a test is performed where each version of the function returns the
|
-- entire char_array referenced by the in parameter Ref.
|
-- entire char_array referenced by the in parameter Ref.
|
-- Finally, both versions of Function Value are called with a null
|
-- Finally, both versions of Function Value are called with a null
|
-- pointer reference, to ensure that Dereference_Error is raised in
|
-- pointer reference, to ensure that Dereference_Error is raised in
|
-- this case.
|
-- this case.
|
--
|
--
|
-- 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', and 'A'..'Z'.
|
-- ' ', 'a'..'z', and 'A'..'Z'.
|
--
|
--
|
-- APPLICABILITY CRITERIA:
|
-- APPLICABILITY CRITERIA:
|
-- This test is applicable to all implementations that provide
|
-- This test is applicable to all implementations that provide
|
-- packages Interfaces.C.Strings and Interfaces.C.Pointers. If an
|
-- packages Interfaces.C.Strings and Interfaces.C.Pointers. If an
|
-- implementation provides packages Interfaces.C.Strings and
|
-- implementation provides packages Interfaces.C.Strings and
|
-- Interfaces.C.Pointers, this test must compile, execute, and
|
-- Interfaces.C.Pointers, this test must compile, execute, and
|
-- report "PASSED".
|
-- report "PASSED".
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 19 Oct 95 SAIC Initial prerelease version.
|
-- 19 Oct 95 SAIC Initial prerelease version.
|
-- 13 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
|
-- 13 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
|
-- 23 Oct 96 SAIC Incorporated reviewer comments.
|
-- 23 Oct 96 SAIC Incorporated reviewer comments.
|
--
|
--
|
--!
|
--!
|
|
|
with Report;
|
with Report;
|
with Interfaces.C.Strings; -- N/A => ERROR
|
with Interfaces.C.Strings; -- N/A => ERROR
|
with Interfaces.C.Pointers; -- N/A => ERROR
|
with Interfaces.C.Pointers; -- N/A => ERROR
|
|
|
procedure CXB3014 is
|
procedure CXB3014 is
|
|
|
begin
|
begin
|
|
|
Report.Test ("CXB3014", "Check that versions of the Value function " &
|
Report.Test ("CXB3014", "Check that versions of the Value function " &
|
"from package Interfaces.C.Pointers produce " &
|
"from package Interfaces.C.Pointers produce " &
|
"correct results");
|
"correct results");
|
|
|
Test_Block:
|
Test_Block:
|
declare
|
declare
|
|
|
use type Interfaces.C.char, Interfaces.C.size_t;
|
use type Interfaces.C.char, Interfaces.C.size_t;
|
|
|
Char_a : constant Interfaces.C.char := 'a';
|
Char_a : constant Interfaces.C.char := 'a';
|
Char_j : constant Interfaces.C.char := 'j';
|
Char_j : constant Interfaces.C.char := 'j';
|
Char_z : constant Interfaces.C.char := 'z';
|
Char_z : constant Interfaces.C.char := 'z';
|
|
|
subtype Lower_Case_chars is Interfaces.C.char range Char_a..Char_z;
|
subtype Lower_Case_chars is Interfaces.C.char range Char_a..Char_z;
|
subtype Char_Range is Interfaces.C.size_t range 0..26;
|
subtype Char_Range is Interfaces.C.size_t range 0..26;
|
|
|
Local_nul : aliased Interfaces.C.char := Interfaces.C.nul;
|
Local_nul : aliased Interfaces.C.char := Interfaces.C.nul;
|
TC_Array_Size : Interfaces.C.size_t := 20;
|
TC_Array_Size : Interfaces.C.size_t := 20;
|
|
|
TC_String_1 : constant String := "abcdefghij";
|
TC_String_1 : constant String := "abcdefghij";
|
TC_String_2 : constant String := "abcdefghijklmnopqrstuvwxyz";
|
TC_String_2 : constant String := "abcdefghijklmnopqrstuvwxyz";
|
TC_String_3 : constant String := "abcdefghijklmnopqrst";
|
TC_String_3 : constant String := "abcdefghijklmnopqrst";
|
TC_String_4 : constant String := "abcdefghijklmnopqrstuvwxyz";
|
TC_String_4 : constant String := "abcdefghijklmnopqrstuvwxyz";
|
TC_Blank_String : constant String := " ";
|
TC_Blank_String : constant String := " ";
|
|
|
TC_Char_Array : Interfaces.C.char_array(Char_Range) :=
|
TC_Char_Array : Interfaces.C.char_array(Char_Range) :=
|
Interfaces.C.To_C(TC_String_2, True);
|
Interfaces.C.To_C(TC_String_2, True);
|
|
|
TC_Char_Array_1 : Interfaces.C.char_array(0..9);
|
TC_Char_Array_1 : Interfaces.C.char_array(0..9);
|
TC_Char_Array_2 : Interfaces.C.char_array(Char_Range);
|
TC_Char_Array_2 : Interfaces.C.char_array(Char_Range);
|
TC_Char_Array_3 : Interfaces.C.char_array(0..TC_Array_Size-1);
|
TC_Char_Array_3 : Interfaces.C.char_array(0..TC_Array_Size-1);
|
TC_Char_Array_4 : Interfaces.C.char_array(Char_Range);
|
TC_Char_Array_4 : Interfaces.C.char_array(Char_Range);
|
|
|
package Char_Pointers is new
|
package Char_Pointers is new
|
Interfaces.C.Pointers (Index => Interfaces.C.size_t,
|
Interfaces.C.Pointers (Index => Interfaces.C.size_t,
|
Element => Interfaces.C.char,
|
Element => Interfaces.C.char,
|
Element_Array => Interfaces.C.char_array,
|
Element_Array => Interfaces.C.char_array,
|
Default_Terminator => Interfaces.C.nul);
|
Default_Terminator => Interfaces.C.nul);
|
|
|
Char_Ptr : Char_Pointers.Pointer;
|
Char_Ptr : Char_Pointers.Pointer;
|
|
|
use type Char_Pointers.Pointer;
|
use type Char_Pointers.Pointer;
|
|
|
begin
|
begin
|
|
|
-- Check that the Function Value with Pointer and Terminator Element
|
-- Check that the Function Value with Pointer and Terminator Element
|
-- parameters will return an Element_Array result of appropriate size
|
-- parameters will return an Element_Array result of appropriate size
|
-- and content (up to and including the first "terminator" Element.)
|
-- and content (up to and including the first "terminator" Element.)
|
|
|
Char_Ptr := TC_Char_Array(0)'Access;
|
Char_Ptr := TC_Char_Array(0)'Access;
|
|
|
-- Provide a new Terminator char in the call of Function Value.
|
-- Provide a new Terminator char in the call of Function Value.
|
-- This call should return only a portion (the first 10 chars) of
|
-- This call should return only a portion (the first 10 chars) of
|
-- the referenced char_array, up to and including the char 'j'.
|
-- the referenced char_array, up to and including the char 'j'.
|
|
|
TC_Char_Array_1 := Char_Pointers.Value(Ref => Char_Ptr,
|
TC_Char_Array_1 := Char_Pointers.Value(Ref => Char_Ptr,
|
Terminator => Char_j);
|
Terminator => Char_j);
|
|
|
if Interfaces.C.To_Ada(TC_Char_Array_1, False) /= TC_String_1 or
|
if Interfaces.C.To_Ada(TC_Char_Array_1, False) /= TC_String_1 or
|
Interfaces.C.Is_Nul_Terminated(TC_Char_Array_1)
|
Interfaces.C.Is_Nul_Terminated(TC_Char_Array_1)
|
then
|
then
|
Report.Failed("Incorrect result from Function Value with Ref " &
|
Report.Failed("Incorrect result from Function Value with Ref " &
|
"and Terminator parameters, when supplied with " &
|
"and Terminator parameters, when supplied with " &
|
"a non-default Terminator char");
|
"a non-default Terminator char");
|
end if;
|
end if;
|
|
|
-- Use the default Terminator char in the call of Function Value.
|
-- Use the default Terminator char in the call of Function Value.
|
-- This call should return the entire char_array, including the
|
-- This call should return the entire char_array, including the
|
-- terminating nul char.
|
-- terminating nul char.
|
|
|
TC_Char_Array_2 := Char_Pointers.Value(Char_Ptr);
|
TC_Char_Array_2 := Char_Pointers.Value(Char_Ptr);
|
|
|
if Interfaces.C.To_Ada(TC_Char_Array_2, True) /= TC_String_2 or
|
if Interfaces.C.To_Ada(TC_Char_Array_2, True) /= TC_String_2 or
|
not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_2)
|
not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_2)
|
then
|
then
|
Report.Failed("Incorrect result from Function Value with Ref " &
|
Report.Failed("Incorrect result from Function Value with Ref " &
|
"and Terminator parameters, when using the " &
|
"and Terminator parameters, when using the " &
|
"default Terminator char");
|
"default Terminator char");
|
end if;
|
end if;
|
|
|
|
|
|
|
-- Check that the Function Value with Pointer and Length parameters
|
-- Check that the Function Value with Pointer and Length parameters
|
-- will return an Element_Array result of appropriate size and content
|
-- will return an Element_Array result of appropriate size and content
|
-- (the first Length elements pointed to by the parameter Ref).
|
-- (the first Length elements pointed to by the parameter Ref).
|
|
|
-- This call should return only a portion (the first 20 chars) of
|
-- This call should return only a portion (the first 20 chars) of
|
-- the referenced char_array.
|
-- the referenced char_array.
|
|
|
TC_Char_Array_3 :=
|
TC_Char_Array_3 :=
|
Char_Pointers.Value(Ref => Char_Ptr,
|
Char_Pointers.Value(Ref => Char_Ptr,
|
Length => Interfaces.C.ptrdiff_t(TC_Array_Size));
|
Length => Interfaces.C.ptrdiff_t(TC_Array_Size));
|
|
|
-- Verify the individual chars of the result.
|
-- Verify the individual chars of the result.
|
for i in 0..TC_Array_Size-1 loop
|
for i in 0..TC_Array_Size-1 loop
|
if Interfaces.C.To_Ada(TC_Char_Array_3(i)) /=
|
if Interfaces.C.To_Ada(TC_Char_Array_3(i)) /=
|
TC_String_3(Integer(i)+1)
|
TC_String_3(Integer(i)+1)
|
then
|
then
|
Report.Failed("Incorrect result from Function Value with " &
|
Report.Failed("Incorrect result from Function Value with " &
|
"Ref and Length parameters, when specifying " &
|
"Ref and Length parameters, when specifying " &
|
"a length less than the full array size");
|
"a length less than the full array size");
|
exit;
|
exit;
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
-- This call should return the entire char_array, including the
|
-- This call should return the entire char_array, including the
|
-- terminating nul char.
|
-- terminating nul char.
|
|
|
TC_Char_Array_4 := Char_Pointers.Value(Char_Ptr, 27);
|
TC_Char_Array_4 := Char_Pointers.Value(Char_Ptr, 27);
|
|
|
if Interfaces.C.To_Ada(TC_Char_Array_4, True) /= TC_String_4 or
|
if Interfaces.C.To_Ada(TC_Char_Array_4, True) /= TC_String_4 or
|
not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_4)
|
not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_4)
|
then
|
then
|
Report.Failed("Incorrect result from Function Value with Ref " &
|
Report.Failed("Incorrect result from Function Value with Ref " &
|
"and Length parameters, when specifying the " &
|
"and Length parameters, when specifying the " &
|
"entire array size");
|
"entire array size");
|
end if;
|
end if;
|
|
|
|
|
|
|
-- Check that both of the above versions of Function Value will
|
-- Check that both of the above versions of Function Value will
|
-- propagate Interfaces.C.Strings.Dereference_Error when the value of
|
-- propagate Interfaces.C.Strings.Dereference_Error when the value of
|
-- the Ref Pointer parameter is null.
|
-- the Ref Pointer parameter is null.
|
|
|
Char_Ptr := null;
|
Char_Ptr := null;
|
|
|
begin
|
begin
|
TC_Char_Array_1 := Char_Pointers.Value(Ref => Char_Ptr,
|
TC_Char_Array_1 := Char_Pointers.Value(Ref => Char_Ptr,
|
Terminator => Char_j);
|
Terminator => Char_j);
|
Report.Failed("Dereference_Error not raised by Function " &
|
Report.Failed("Dereference_Error not raised by Function " &
|
"Value with Terminator parameter, when " &
|
"Value with Terminator parameter, when " &
|
"provided a null reference");
|
"provided a null reference");
|
-- Call Report.Comment to ensure that the assignment to
|
-- Call Report.Comment to ensure that the assignment to
|
-- TC_Char_Array_1 is not "dead", and therefore can not be
|
-- TC_Char_Array_1 is not "dead", and therefore can not be
|
-- optimized away.
|
-- optimized away.
|
Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_1, False));
|
Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_1, False));
|
exception
|
exception
|
when Interfaces.C.Strings.Dereference_Error =>
|
when Interfaces.C.Strings.Dereference_Error =>
|
null; -- OK, expected exception.
|
null; -- OK, expected exception.
|
when others =>
|
when others =>
|
Report.Failed("Incorrect exception raised by Function " &
|
Report.Failed("Incorrect exception raised by Function " &
|
"Value with Terminator parameter, when " &
|
"Value with Terminator parameter, when " &
|
"provided a null reference");
|
"provided a null reference");
|
end;
|
end;
|
|
|
|
|
begin
|
begin
|
TC_Char_Array_3 :=
|
TC_Char_Array_3 :=
|
Char_Pointers.Value(Char_Ptr,
|
Char_Pointers.Value(Char_Ptr,
|
Interfaces.C.ptrdiff_t(TC_Array_Size));
|
Interfaces.C.ptrdiff_t(TC_Array_Size));
|
Report.Failed("Dereference_Error not raised by Function " &
|
Report.Failed("Dereference_Error not raised by Function " &
|
"Value with Length parameter, when provided " &
|
"Value with Length parameter, when provided " &
|
"a null reference");
|
"a null reference");
|
-- Call Report.Comment to ensure that the assignment to
|
-- Call Report.Comment to ensure that the assignment to
|
-- TC_Char_Array_3 is not "dead", and therefore can not be
|
-- TC_Char_Array_3 is not "dead", and therefore can not be
|
-- optimized away.
|
-- optimized away.
|
Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_3, False));
|
Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_3, False));
|
exception
|
exception
|
when Interfaces.C.Strings.Dereference_Error =>
|
when Interfaces.C.Strings.Dereference_Error =>
|
null; -- OK, expected exception.
|
null; -- OK, expected exception.
|
when others =>
|
when others =>
|
Report.Failed("Incorrect exception raised by Function " &
|
Report.Failed("Incorrect exception raised by Function " &
|
"Value with Length parameter, when " &
|
"Value with Length parameter, when " &
|
"provided a null reference");
|
"provided a null reference");
|
end;
|
end;
|
|
|
|
|
exception
|
exception
|
when others => Report.Failed ("Exception raised in Test_Block");
|
when others => Report.Failed ("Exception raised in Test_Block");
|
end Test_Block;
|
end Test_Block;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end CXB3014;
|
end CXB3014;
|
|
|