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

   1 -- CXB3002.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.Strings
  28 --      are available for use.
  29 --
  30 -- TEST DESCRIPTION:
  31 --      This test verifies that the types and subprograms specified for the
  32 --      interface are present
  33 --
  34 -- APPLICABILITY CRITERIA:
  35 --      If an implementation provides packages Interfaces.C and
  36 --      Interfaces.C.Strings, this test must compile, execute, and
  37 --      report "PASSED".
  38 --
  39 --
  40 -- CHANGE HISTORY:
  41 --      06 Dec 94   SAIC    ACVC 2.0
  42 --      28 Feb 96   SAIC    Added applicability criteria.
  43 --
  44 --!
  45
  46 with Report;
  47 with Interfaces.C;                                            -- N/A => ERROR
  48 with Interfaces.C.Strings;                                    -- N/A => ERROR
  49
  50 procedure CXB3002 is
  51    package Strings renames Interfaces.C.Strings;
  52    package C renames Interfaces.C;
  53
  54 begin
  55
  56    Report.Test ("CXB3002", "Check the specification of Interfaces.C.Strings");
  57
  58
  59    declare  -- encapsulate the test
  60
  61       TC_Int_1      : integer := 1;
  62       TC_Int_2      : integer := 1;
  63       TC_String     : String := "ABCD";
  64       TC_Boolean    : Boolean := true;
  65       TC_char_array : C.char_array (1..5);
  66       TC_size_t     : C.size_t := C.size_t'first;
  67
  68
  69       --  Note In all of the following the Strings spec. being tested
  70       --  is shown in comment lines
  71       --
  72       --    type char_array_access is access all char_array;
  73       TST_char_array_access :  Strings.char_array_access :=
  74                                        new Interfaces.C.char_array (1..5);
  75
  76       --    type chars_ptr is private;
  77       --    Null_Ptr : constant chars_ptr;
  78       TST_chars_ptr : Strings.chars_ptr := Strings.Null_ptr;
  79
  80       --  type chars_ptr_array is array (size_t range <>) of chars_ptr;
  81       TST_chars_ptr_array : Strings.chars_ptr_array(1..5);
  82
  83    begin    -- encapsulation
  84
  85       -- Arrange that the calls to the subprograms are compiled but
  86       -- not executed
  87       --
  88       if not Report.Equal ( TC_Int_1, TC_Int_2 ) then
  89
  90          --    function To_Chars_Ptr (Item      : in char_array_access;
  91          --                           Nul_Check : in Boolean := False)
  92          --       return chars_ptr;
  93          TST_chars_ptr := Strings.To_Chars_Ptr
  94                                           (TST_char_array_access, TC_Boolean);
  95
  96          --    This one is out of LRM order so that we can "initialize"
  97          --    TC_char_array for the "in" parameter of the next one
  98          --
  99          --    function Value (Item : in chars_ptr) return char_array;
 100          TC_char_array := Strings.Value (TST_chars_ptr);
 101
 102          --    function New_Char_Array (Chars   : in char_array)
 103          --       return chars_ptr;
 104          TST_chars_ptr := Strings.New_Char_Array (TC_char_array);
 105
 106          --    function New_String (Str : in String) return chars_ptr;
 107          TST_chars_ptr := Strings.New_String ("TEST STRING");
 108
 109          --    procedure Free (Item : in out chars_ptr);
 110          Strings.Free (TST_chars_ptr);
 111
 112          --    function Value (Item : in chars_ptr; Length : in size_t)
 113          --       return char_array;
 114          TC_char_array := Strings.Value (TST_chars_ptr, TC_size_t);
 115
 116          -- Use Report.Comment as a known procedure which takes a string as
 117          -- a parameter (this does not actually get output)
 118          --    function Value (Item : in chars_ptr) return String;
 119          Report.Comment ( Strings.Value (TST_chars_ptr) );
 120
 121          --    function Value (Item : in chars_ptr; Length : in size_t)
 122          --       return String;
 123          TC_String := Strings.Value (TST_chars_ptr, TC_size_t);
 124
 125          --    function Strlen (Item : in chars_ptr) return size_t;
 126          TC_size_t := Strings.Strlen (TST_chars_ptr);
 127
 128          --    procedure Update (Item   : in chars_ptr;
 129          --                      Offset : in size_t;
 130          --                      Chars  : in char_array;
 131          --                      Check  : in Boolean := True);
 132          Strings.Update (TST_chars_ptr, TC_size_t, TC_char_array, TC_Boolean);
 133
 134          --    procedure Update (Item   : in chars_ptr;
 135          --                      Offset : in size_t;
 136          --                      Str    : in String;
 137          --                      Check  : in Boolean := True);
 138          Strings.Update (TST_chars_ptr, TC_size_t, TC_String, TC_Boolean);
 139
 140          --    Update_Error : exception;
 141          raise Strings.Update_Error;
 142
 143       end if;
 144
 145       if not Report.Equal ( TC_Int_2, TC_Int_1 ) then
 146
 147          -- This exception is out of LRM presentation order to avoid
 148          -- compiler warnings about unreachable code
 149          --    Dereference_Error : exception;
 150          raise Strings.Dereference_Error;
 151
 152       end if;
 153
 154    end;     -- encapsulation
 155
 156    Report.Result;
 157
 158 end CXB3002;