gcc/testsuite/ada/acats/tests/cxb/cxb3001.a

   1 -- CXB3001.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- OBJECTIVE:
  27 --      Check that the specifications of the package Interfaces.C are
  28 --      available for use.
  29 --
  30 -- TEST DESCRIPTION:
  31 --      This test verifies that the types and subprograms specified for the
  32 --      interface are present.  It just checks for the presence of
  33 --      the subprograms.  Other tests are designed to exercise the interface.
  34 --
  35 -- APPLICABILITY CRITERIA:
  36 --      If an implementation provides package Interfaces.C, this test
  37 --      must compile, execute, and report "PASSED".
  38 --
  39 --
  40 -- CHANGE HISTORY:
  41 --      06 Dec 94   SAIC    ACVC 2.0
  42 --      15 Nov 95   SAIC    Corrected To_C parameter list for ACVC 2.0.1.
  43 --      28 Feb 96   SAIC    Added applicability criteria.
  44 --
  45 --!
  46
  47 with Report;
  48 with Interfaces.C;                                             -- N/A => ERROR
  49
  50 procedure CXB3001 is
  51    package C renames Interfaces.C;
  52    use type C.signed_char;
  53    use type C.unsigned_char;
  54    use type C.char;
  55
  56 begin
  57
  58    Report.Test ("CXB3001", "Check the specification of Interfaces.C");
  59
  60    declare  -- encapsulate the test
  61
  62
  63       tst_CHAR_BIT  : constant :=  C.CHAR_BIT;
  64       tst_SCHAR_MIN : constant :=  C.SCHAR_MIN;
  65       tst_SCHAR_MAX : constant :=  C.SCHAR_MAX;
  66       tst_UCHAR_MAX : constant :=  C.UCHAR_MAX;
  67
  68       -- Signed and Unsigned Integers
  69
  70       tst_int   : C.int   := C.int'first;
  71       tst_short : C.short := C.short'first;
  72       tst_long  : C.long  := C.long'first;
  73
  74       tst_signed_char_min : C.signed_char :=  C.signed_char'first;
  75       tst_signed_char_max : C.signed_char :=  C.signed_char'last;
  76
  77       tst_unsigned        : C.unsigned;
  78       tst_unsigned_short  : C.unsigned_short;
  79       tst_unsigned_long   : C.unsigned_long;
  80
  81       tst_unsigned_char :  C.unsigned_char;
  82       tst_plain_char    :  C.plain_char;
  83
  84       tst_ptrdiff_t : C.ptrdiff_t;
  85       tst_size_t    : C.size_t;
  86
  87       -- Floating-Point
  88
  89       tst_C_float     : C.C_float;
  90       tst_double      : C.double;
  91       tst_long_double : C.long_double;
  92
  93       -- Characters and Strings
  94
  95       tst_char : C.char;
  96       tst_nul  : C.char := C.nul;
  97
  98       -- Collect all the subprogram calls such that they are compiled
  99       -- but not executed
 100       --
 101       procedure Collect_All_Calls is
 102
 103          CAC_char           : C.char;
 104          CAC_Character      : Character;
 105          CAC_String         : string (1..5);
 106          CAC_Boolean        : Boolean := false;
 107          CAC_char_array     : C.char_array(1..5);
 108          CAC_Integer        : integer;
 109          CAC_Natural        : natural;
 110          CAC_wchar_t        : C.wchar_t;
 111          CAC_Wide_Character : Wide_Character;
 112          CAC_wchar_array    : C.wchar_array(1..5);
 113          CAC_Wide_String    : Wide_String(1..5);
 114          CAC_size_t         : C.size_t;
 115
 116       begin
 117
 118          CAC_char      := C.To_C (CAC_Character);
 119          CAC_Character := C.To_Ada (CAC_char);
 120
 121          CAC_char_array :=  C.To_C (CAC_String, CAC_Boolean);
 122          CAC_String     :=  C.To_Ada (CAC_char_array, CAC_Boolean);
 123
 124          -- This call is out of LRM order so that we can use the
 125          -- array initialized above
 126          CAC_Boolean  := C.Is_Nul_Terminated (CAC_char_array);
 127
 128          C.To_C   (CAC_String, CAC_char_array, CAC_size_t, CAC_Boolean);
 129          C.To_Ada (CAC_char_array, CAC_String, CAC_Natural, CAC_Boolean);
 130
 131          CAC_wchar_t        := C.To_C (CAC_Wide_Character);
 132          CAC_Wide_Character := C.To_Ada (CAC_wchar_t);
 133          CAC_wchar_t        := C.wide_nul;
 134
 135          CAC_wchar_array :=  C.To_C   (CAC_Wide_String, CAC_Boolean);
 136          CAC_Wide_String :=  C.To_Ada (CAC_wchar_array, CAC_Boolean);
 137
 138          -- This call is out of LRM order so that we can use the
 139          -- array initialized above
 140          CAC_Boolean  := C.Is_Nul_Terminated (CAC_wchar_array);
 141
 142          C.To_C   (CAC_Wide_String, CAC_wchar_array, CAC_size_t,  CAC_Boolean);
 143          C.To_Ada (CAC_wchar_array, CAC_Wide_String, CAC_Natural, CAC_Boolean);
 144
 145          raise C.Terminator_Error;
 146
 147       end Collect_All_Calls;
 148
 149
 150
 151    begin    -- encapsulation
 152
 153       if  tst_signed_char_min /= C.SCHAR_MIN then
 154          Report.Failed  ("tst_signed_char_min is incorrect");
 155       end if;
 156       if  tst_signed_char_max /= C.SCHAR_MAX then
 157          Report.Failed  ("tst_signed_char_max is incorrect");
 158       end if;
 159       if C.signed_char'Size /= C.CHAR_BIT then
 160          Report.Failed  ("C.signed_char'Size is incorrect");
 161       end if;
 162
 163       if C.unsigned_char'first /= 0                or
 164          C.unsigned_char'last  /= C.UCHAR_MAX      or
 165          C.unsigned_char'size  /= C.CHAR_BIT       then
 166
 167             Report.Failed  ("unsigned_char is incorrectly defined");
 168
 169       end if;
 170
 171       if tst_nul /= C.char'first then
 172          Report.Failed  ("tst_nul is incorrect");
 173       end if;
 174
 175    end;     -- encapsulation
 176
 177    Report.Result;
 178
 179 end CXB3001;