summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/cxb/cxb30132.am
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/cxb30132.am
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/cxb30132.am')
-rw-r--r--gcc/testsuite/ada/acats/tests/cxb/cxb30132.am205
1 files changed, 205 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxb/cxb30132.am b/gcc/testsuite/ada/acats/tests/cxb/cxb30132.am
new file mode 100644
index 000000000..4cff400b8
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/cxb/cxb30132.am
@@ -0,0 +1,205 @@
+-- CXB30132.AM
+--
+-- 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 imported, user-defined C language functions can be
+-- called from an Ada program.
+--
+-- TEST DESCRIPTION:
+-- This test checks that user-defined C language functions can be
+-- imported and referenced from an Ada program. Two C language
+-- functions are specified in files CXB30130.C and CXB30131.C.
+-- These two functions are imported to this test program, using two
+-- calls to Pragma Import. Each function is then called in this test,
+-- and the results of the call are verified.
+--
+-- This test assumes that the following characters are all included
+-- in the implementation defined type Interfaces.C.char:
+-- ' ', 'a'..'z', and 'A'..'Z'.
+--
+-- APPLICABILITY CRITERIA:
+-- This test is applicable to all implementations that provide
+-- packages Interfaces.C and Interfaces.C.Strings. If an
+-- implementation provides packages Interfaces.C and
+-- Interfaces.C.Strings, this test must compile, execute, and
+-- report "PASSED".
+--
+-- SPECIAL REQUIREMENTS:
+-- The files CXB30130.C and CXB30131.C must be compiled with a C
+-- compiler. Implementation dialects of C may require alteration of
+-- the C program syntax (see individual C files).
+--
+-- Note that the compiled C code must be bound with the compiled Ada
+-- code to create an executable image. An implementation must provide
+-- the necessary commands to accomplish this.
+--
+-- Note that the C code included in CXB30130.C and CXB30131.C conforms
+-- to ANSI-C. Modifications to these files may be required for other
+-- C compilers. An implementation must provide the necessary
+-- modifications to satisfy the function requirements.
+--
+-- TEST FILES:
+-- The following files comprise this test:
+--
+-- CXB30130.C
+-- CXB30131.C
+-- CXB30132.AM
+--
+--
+-- CHANGE HISTORY:
+-- 13 Oct 95 SAIC Initial prerelease version.
+-- 13 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
+-- 26 Oct 96 SAIC Incorporated reviewer comments.
+--
+--!
+
+with Report;
+with Impdef;
+with Interfaces.C; -- N/A => ERROR
+with Interfaces.C.Strings; -- N/A => ERROR
+
+procedure CXB30132 is
+begin
+
+ Report.Test ("CXB3013", "Check that user-defined C functions can " &
+ "be imported into an Ada program");
+
+ Test_Block:
+ declare
+
+ package IC renames Interfaces.C;
+ package ICS renames Interfaces.C.Strings;
+
+ use type IC.char_array;
+ use type IC.int;
+ use type IC.short;
+ use type IC.C_float;
+ use type IC.double;
+
+ type Short_Ptr is access all IC.short;
+ type Float_Ptr is access all IC.C_float;
+ type Double_Ptr is access all IC.double;
+ subtype Char_Array_Type is IC.char_array(0..20);
+
+ TC_Default_int : IC.int := 49;
+ TC_Default_short : IC.short := 3;
+ TC_Default_float : IC.C_float := 50.0;
+ TC_Default_double : IC.double := 1209.0;
+
+ An_Int_Value : IC.int := TC_Default_int;
+ A_Short_Value : aliased IC.short := TC_Default_short;
+ A_Float_Value : aliased IC.C_float := TC_Default_float;
+ A_Double_Value : aliased IC.double := TC_Default_double;
+
+ A_Short_Int_Pointer : Short_Ptr := A_Short_Value'access;
+ A_Float_Pointer : Float_Ptr := A_Float_Value'access;
+ A_Double_Pointer : Double_Ptr := A_Double_Value'access;
+
+ Char_Array_1 : Char_Array_Type;
+ Char_Array_2 : Char_Array_Type;
+ Char_Pointer : ICS.chars_ptr;
+
+ TC_Char_Array : constant Char_Array_Type :=
+ "Look before you leap" & IC.nul;
+ TC_Return_int : IC.int := 0;
+
+ -- The Square_It function returns the square of the value The_Int
+ -- through the function name, and returns the square of the other
+ -- parameters through the parameter list (the last three parameters
+ -- are access values).
+
+ function Square_It (The_Int : in IC.int;
+ The_Short : in Short_Ptr;
+ The_Float : in Float_Ptr;
+ The_Double : in Double_Ptr) return IC.int;
+
+ -- The Combine_Strings function returns the result of the catenation
+ -- of the two string parameters through the function name.
+
+ function Combine_Strings (First_Part : in IC.char_array;
+ Second_Part : in IC.char_array)
+ return ICS.chars_ptr;
+
+
+ -- Use the user-defined C function square_it as a completion to the
+ -- function specification above.
+
+ pragma Import (Convention => C,
+ Entity => Square_It,
+ External_Name => Impdef.CXB30130_External_Name);
+
+ -- Use the user-defined C function combine_two_strings as a completion
+ -- to the function specification above.
+
+ pragma Import (C, Combine_Strings, Impdef.CXB30131_External_Name);
+
+
+ begin
+
+ -- Check that the imported version of C function CXB30130 produces
+ -- the correct results.
+
+ TC_Return_int := Square_It (The_Int => An_Int_Value,
+ The_Short => A_Short_Int_Pointer,
+ The_Float => A_Float_Pointer,
+ The_Double => A_Double_Pointer);
+
+ -- Compare the results with the expected results. Note that in the
+ -- case of the three "pointer" parameters, the objects being pointed
+ -- to have been modified as a result of the function.
+
+ if TC_Return_int /= An_Int_Value * An_Int_Value or
+ A_Short_Int_Pointer.all /= TC_Default_short * TC_Default_Short or
+ A_Short_Value /= TC_Default_short * TC_Default_Short or
+ A_Float_Pointer.all /= TC_Default_float * TC_Default_float or
+ A_Float_Value /= TC_Default_float * TC_Default_float or
+ A_Double_Pointer.all /= TC_Default_double * TC_Default_double or
+ A_Double_Value /= TC_Default_double * TC_Default_double
+ then
+ Report.Failed("Incorrect results returned from function square_it");
+ end if;
+
+
+ -- Check that two char_array values are combined by the imported
+ -- C function CXB30131.
+
+ Char_Array_1(0..12) := "Look before " & IC.nul;
+ Char_Array_2(0..8) := "you leap" & IC.nul;
+
+ Char_Pointer := Combine_Strings (Char_Array_1, Char_Array_2);
+
+ if ICS.Value(Char_Pointer) /= TC_Char_Array then
+ Report.Failed("Incorrect value returned from imported function " &
+ "combine_two_strings");
+ end if;
+
+
+ exception
+ when others => Report.Failed ("Exception raised in Test_Block");
+ end Test_Block;
+
+ Report.Result;
+
+end CXB30132;