diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxb/cxb3008.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cxb/cxb3008.a | 226 |
1 files changed, 0 insertions, 226 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxb/cxb3008.a b/gcc/testsuite/ada/acats/tests/cxb/cxb3008.a deleted file mode 100644 index 9df19d814c3..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxb/cxb3008.a +++ /dev/null @@ -1,226 +0,0 @@ --- CXB3008.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 functions imported from the C language <string.h> and --- <stdlib.h> libraries can be called from an Ada program. --- --- TEST DESCRIPTION: --- This test checks that C language functions from the <string.h> and --- <stdlib.h> libraries can be used as completions of Ada subprograms. --- A pragma Import with convention identifier "C" is used to complete --- the Ada subprogram specifications. --- The three subprogram cases tested are as follows: --- 1) A C function that returns an int value (strcpy) is used as the --- completion of an Ada procedure specification. The return value --- is discarded; parameter modification is the desired effect. --- 2) A C function that returns an int value (strlen) is used as the --- completion of an Ada function specification. --- 3) A C function that returns a double value (strtod) is used as the --- completion of an Ada function specification. --- --- 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 --- packages Interfaces.C and Interfaces.C.Strings. If an --- implementation provides these packages, this test must compile, --- execute, and report "PASSED". --- --- SPECIAL REQUIREMENTS: --- The C language library functions used by this test must be --- available for importing into the test. --- --- --- CHANGE HISTORY: --- 12 Oct 95 SAIC Initial prerelease version. --- 09 May 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- 01 DEC 97 EDS Replaced all references of C function atof with --- C function strtod. --- 29 JUN 98 EDS Give Ada function corresponding to strtod a --- second parameter. ---! - -with Report; -with Ada.Exceptions; -with Interfaces.C; -- N/A => ERROR -with Interfaces.C.Strings; -- N/A => ERROR -with Interfaces.C.Pointers; - -procedure CXB3008 is -begin - - Report.Test ("CXB3008", "Check that functions imported from the " & - "C language predefined libraries can be " & - "called from an Ada program"); - - Test_Block: - declare - - package IC renames Interfaces.C; - package ICS renames Interfaces.C.Strings; - package ICP is new Interfaces.C.Pointers - ( Index => IC.size_t, - Element => IC.char, - Element_Array => IC.char_array, - Default_Terminator => IC.nul ); - use Ada.Exceptions; - - use type IC.char; - use type IC.char_array; - use type IC.size_t; - use type IC.double; - - -- The String_Copy procedure copies the string pointed to by Source, - -- including the terminating nul char, into the char_array pointed - -- to by Target. - - procedure String_Copy (Target : out IC.char_array; - Source : in IC.char_array); - - -- The String_Length function returns the length of the nul-terminated - -- string pointed to by The_String. The nul is not included in - -- the count. - - function String_Length (The_String : in IC.char_array) - return IC.size_t; - - -- The String_To_Double function converts the char_array pointed to - -- by The_String into a double value returned through the function - -- name. The_String must contain a valid floating-point number; if - -- not, the value returned is zero. - --- type Acc_ptr is access IC.char_array; - function String_To_Double (The_String : in IC.char_array ; - End_Ptr : ICP.Pointer := null) - return IC.double; - - - -- Use the <string.h> strcpy function as a completion to the procedure - -- specification. Note that the Ada interface to this C function is - -- in the form of a procedure (C function return value is not used). - - pragma Import (C, String_Copy, "strcpy"); - - -- Use the <string.h> strlen function as a completion to the - -- String_Length function specification. - - pragma Import (C, String_Length, "strlen"); - - -- Use the <stdlib.h> strtod function as a completion to the - -- String_To_Double function specification. - - pragma Import (C, String_To_Double, "strtod"); - - - TC_String : constant String := "Just a Test"; - Char_Source : IC.char_array(0..30); - Char_Target : IC.char_array(0..30); - Double_Result : IC.double; - Source_Ptr, - Target_Ptr : ICS.chars_ptr; - - begin - - -- Check that the imported version of C function strcpy produces - -- the correct results. - - Char_Source(0..21) := "Test of Pragma Import" & IC.nul; - - String_Copy(Char_Target, Char_Source); - - if Char_Target(0..21) /= Char_Source(0..21) then - Report.Failed("Incorrect result from the imported version of " & - "strcpy - 1"); - end if; - - if String_Length(Char_Target) /= 21 then - Report.Failed("Incorrect result from the imported version of " & - "strlen - 1"); - end if; - - Char_Source(0) := IC.nul; - - String_Copy(Char_Target, Char_Source); - - if Char_Target(0) /= Char_Source(0) then - Report.Failed("Incorrect result from the imported version of " & - "strcpy - 2"); - end if; - - if String_Length(Char_Target) /= 0 then - Report.Failed("Incorrect result from the imported version of " & - "strlen - 2"); - end if; - - -- The following chars_ptr designates a char_array of 12 chars - -- (including the terminating nul char). - Source_Ptr := ICS.New_Char_Array(IC.To_C(TC_String)); - - String_Copy(Char_Target, ICS.Value(Source_Ptr)); - - Target_Ptr := ICS.New_Char_Array(Char_Target); - - if ICS.Value(Target_Ptr) /= TC_String then - Report.Failed("Incorrect result from the imported version of " & - "strcpy - 3"); - end if; - - if String_Length(ICS.Value(Target_Ptr)) /= TC_String'Length then - Report.Failed("Incorrect result from the imported version of " & - "strlen - 3"); - end if; - - - Char_Source(0..9) := "100.00only"; - - Double_Result := String_To_Double(Char_Source); - - Char_Source(0..13) := "5050.00$$$$$$$"; - - if Double_Result + String_To_Double(Char_Source) /= 5150.00 then - Report.Failed("Incorrect result returned from the imported " & - "version of function strtod - 1"); - end if; - - Char_Source(0..9) := "xxx$10.00x"; -- String doesn't contain a - -- valid floating point value. - if String_To_Double(Char_Source) /= 0.0 then - Report.Failed("Incorrect result returned from the imported " & - "version of function strtod - 2"); - end if; - - - 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 CXB3008; |