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