diff gcc/testsuite/ada/acats/tests/cxb/cxb30132.am @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/cxb/cxb30132.am	Fri Oct 27 22:46:09 2017 +0900
@@ -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;