1-- 2-- CD72A01.A 3-- 4-- Grant of Unlimited Rights 5-- 6-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, 7-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 8-- unlimited rights in the software and documentation contained herein. 9-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making 10-- this public release, the Government intends to confer upon all 11-- recipients unlimited rights equal to those held by the Government. 12-- These rights include rights to use, duplicate, release or disclose the 13-- released technical data and computer software in whole or in part, in 14-- any manner and for any purpose whatsoever, and to have or permit others 15-- to do so. 16-- 17-- DISCLAIMER 18-- 19-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 20-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 21-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 22-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 23-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 24-- PARTICULAR PURPOSE OF SAID MATERIAL. 25--* 26-- 27-- OBJECTIVE: 28-- Check that the package System.Address_To_Access_Conversions may be 29-- instantiated for various simple types. 30-- 31-- Check that To_Pointer and To_Address are inverse operations. 32-- 33-- Check that To_Pointer(X'Address) equals X'Unchecked_Access for an 34-- X that allows Unchecked_Access. 35-- 36-- Check that To_Pointer(Null_Address) returns null. 37-- 38-- TEST DESCRIPTION: 39-- This test checks that the semantics provided in 40-- Address_To_Access_Conversions are present and operate 41-- within expectations (to the best extent possible in a portable 42-- implementation independent fashion). 43-- 44-- The functions Address_To_Hex and Hex_To_Address test the invertability 45-- of the To_Integer and To_Address functions, along with a great deal 46-- of optimizer chaff and protection from the fact that type 47-- Storage_Elements.Integer_Address may be either a modular or a signed 48-- integer type. 49-- 50-- This test has some interesting usage paradigms in that users 51-- occasionally want to store address information in a transportable 52-- fashion, and often resort to some textual representation of values. 53-- 54-- APPLICABILITY CRITERIA: 55-- All implementations must attempt to compile this test. 56-- 57-- For implementations validating against Systems Programming Annex (C): 58-- this test must execute and report PASSED. 59-- 60-- For implementations not validating against Annex C: 61-- this test may report compile time errors at one or more points 62-- indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable. 63-- Otherwise, the test must execute and report PASSED. 64-- 65-- CHANGE HISTORY: 66-- 13 JUL 95 SAIC Initial version (CD72001) 67-- 08 FEB 96 SAIC Revised (split) version for 2.1 68-- 07 MAY 96 SAIC Additional subtest added for 2.1 69-- 16 FEB 98 EDS Modified documentation. 70--! 71 72with Report; 73with Impdef; 74with FD72A00; 75with System.Storage_Elements; 76with System.Address_To_Access_Conversions; 77procedure CD72A01 is 78 use System; 79 use FD72A00; 80 81 package Number_ATAC is 82 new System.Address_To_Access_Conversions(Number); -- ANX-C RQMT 83 84 use type Number_ATAC.Object_Pointer; 85 86 type Data is record 87 One, Two: aliased Number; 88 end record; 89 90 package Data_ATAC is 91 new System.Address_To_Access_Conversions(Data); -- ANX-C RQMT 92 93 use type Data_ATAC.Object_Pointer; 94 95 type Test_Cases is ( Addr_Type, Record_Type ); 96 97 type Naive_Dynamic_String is access String; 98 99 type String_Store is array(Test_Cases) of Naive_Dynamic_String; 100 101 The_Strings : String_Store; 102 103 -- create several aliased objects with distinct values 104 105 My_Number : aliased Number := Number'First; 106 My_Data : aliased Data := (Number'First,Number'Last); 107 108 use type System.Storage_Elements.Integer_Address; 109 110begin -- Main test procedure. 111 112 Report.Test ("CD72A01", "Check package " & 113 "System.Address_To_Access_Conversions " & 114 "for simple types" ); 115 116 -- take several pointer objects, convert them to addresses, and store 117 -- the address as a hexadecimal representation for later reconversion 118 119 The_Strings(Addr_Type) := new String'( 120 Address_To_Hex(Number_ATAC.To_Address(My_Number'Access)) ); 121 122 The_Strings(Record_Type) := new String'( 123 Address_To_Hex(Data_ATAC.To_Address(My_Data'Access)) ); 124 125 -- now, reconvert the hexadecimal address values back to pointers, 126 -- and check that the dereferenced pointer still designates the 127 -- value placed at that location. The use of the intermediate 128 -- string representation should foil even the cleverest of optimizers 129 130 if Number_ATAC.To_Pointer( 131 Hex_To_Address(The_Strings(Addr_Type))).all 132 /= Number'First then 133 Report.Failed("Number reconversion"); 134 end if; 135 136 if Data_ATAC.To_Pointer(Hex_To_Address(The_Strings(Record_Type))).all 137 /= (Number'First,Number'Last) then 138 Report.Failed("Data reconversion"); 139 end if; 140 141 -- check that the resulting values are equal to the 'Unchecked_Access 142 -- of the value 143 144 if Number_ATAC.To_Pointer( 145 Hex_To_Address(The_Strings(Addr_Type))) 146 /= My_Number'Unchecked_Access then 147 Report.Failed("Number Unchecked_Access"); 148 end if; 149 150 if Data_ATAC.To_Pointer(Hex_To_Address(The_Strings(Record_Type))) 151 /= My_Data'Unchecked_Access then 152 Report.Failed("Data Unchecked_Access"); 153 end if; 154 155 if Number_ATAC.To_Pointer(System.Null_Address) /= null then 156 Report.Failed("To_Pointer(Null_Address) /= null"); 157 end if; 158 159 if Number_ATAC.To_Address(null) /= System.Null_Address then 160 Report.Failed("To_Address(null) /= Null_Address"); 161 end if; 162 163 Report.Result; 164 165end CD72A01; 166