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
46with Report;
47with Interfaces.C;                                            -- N/A => ERROR
48with Interfaces.C.Strings;                                    -- N/A => ERROR
49
50procedure CXB3002 is
51   package Strings renames Interfaces.C.Strings;
52   package C renames Interfaces.C;
53
54begin
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
158end CXB3002;
159