1-- CD90001.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 Unchecked_Conversion is supported and is reversible in 28-- the cases where: 29-- Source'Size = Target'Size 30-- Source'Alignment = Target'Alignment 31-- Source and Target are both represented contiguously 32-- Bit pattern in Source is a meaningful value of Target type 33-- 34-- TEST DESCRIPTION: 35-- This test declares an enumeration type with a representation 36-- specification that should fit neatly into an 8 bit object; and a 37-- modular type that should also be able to fit easily into 8 bits; 38-- uses size representation clauses on both of them for 8 bit 39-- representations. It then defines two instances of 40-- Unchecked_Conversion; to convert both ways between the types. 41-- Using several distinctive values, it checks that the conversions 42-- are performed, and reversible. 43-- As a second case, the above is performed with an integer type and 44-- a packed array of booleans. 45-- 46-- APPLICABILITY CRITERIA: 47-- All implementations must attempt to compile this test. 48-- 49-- For implementations validating against Systems Programming Annex (C): 50-- this test must execute and report PASSED. 51-- 52-- For implementations not validating against Annex C: 53-- this test may report compile time errors at one or more points 54-- indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable. 55-- Otherwise, the test must execute and report PASSED. 56-- 57-- 58-- CHANGE HISTORY: 59-- 22 JUL 95 SAIC Initial version 60-- 07 MAY 96 SAIC Changed Boolean to Character for 2.1 61-- 27 JUL 96 SAIC Allowed for partial N/A to be PASS 62-- 14 FEB 97 PWB.CTA Corrected "=" to "/=" in alignment check. 63-- 16 FEB 98 EDS Modified documentation. 64-- 21 DEC 05 RLB Corrected "=" to "/=" in other alignment check. 65--! 66 67----------------------------------------------------------------- CD90001_0 68 69with Report; 70with Unchecked_Conversion; 71package CD90001_0 is 72 73 -- Case 1 : Modular <=> Enumeration 74 75 type Eight_Bits is mod 2**8; 76 for Eight_Bits'Size use 8; 77 78 type User_Enums is ( One, Two, Four, Eight, 79 Sixteen, Thirty_Two, Sixty_Four, One_Twenty_Eight ); 80 for User_Enums'Size use 8; 81 82 for User_Enums use 83 ( One => 1, -- ANX-C RQMT. 84 Two => 2, -- ANX-C RQMT. 85 Four => 4, -- ANX-C RQMT. 86 Eight => 8, -- ANX-C RQMT. 87 Sixteen => 16, -- ANX-C RQMT. 88 Thirty_Two => 32, -- ANX-C RQMT. 89 Sixty_Four => 64, -- ANX-C RQMT. 90 One_Twenty_Eight => 128 ); -- ANX-C RQMT. 91 92 function EB_2_UE is new Unchecked_Conversion( Eight_Bits, User_Enums ); 93 94 function UE_2_EB is new Unchecked_Conversion( User_Enums, Eight_Bits ); 95 96 procedure TC_Check_Case_1; 97 98 -- Case 2 : Integer <=> Packed Character array 99 100 type Signed_16 is range -2**15+1 .. 2**15-1; 101 -- +1, -1 allows for both 1's and 2's comp 102 103 type Bits_16 is array(0..1) of Character; 104 pragma Pack(Bits_16); -- ANX-C RQMT. 105 106 function S16_2_B16 is new Unchecked_Conversion( Signed_16, Bits_16 ); 107 108 function B16_2_S16 is new Unchecked_Conversion( Bits_16, Signed_16 ); 109 110 procedure TC_Check_Case_2; 111 112end CD90001_0; 113 114-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- 115 116with Report; 117package body CD90001_0 is 118 119 Check_List : constant array(1..8) of Eight_Bits 120 := ( 1, 2, 4, 8, 16, 32, 64, 128 ); 121 122 Check_Enum : constant array(1..8) of User_Enums 123 := ( One, Two, Four, Eight, 124 Sixteen, Thirty_Two, Sixty_Four, One_Twenty_Eight ); 125 126 procedure TC_Check_Case_1 is 127 Mod_Value : Eight_Bits; 128 Enum_Val : User_Enums; 129 begin 130 for I in Check_List'Range loop 131 132 if EB_2_UE(Check_List(I)) /= Check_Enum(I) then 133 Report.Failed("EB => UE conversion failed"); 134 end if; 135 136 if Check_List(I) /= UE_2_EB(Check_Enum(I)) then 137 Report.Failed ("EU => EB conversion failed"); 138 end if; 139 140 end loop; 141 end TC_Check_Case_1; 142 143 procedure TC_Check_Case_2 is 144 S: Signed_16; 145 T,U: Signed_16; 146 B: Bits_16; 147 C,D: Bits_16; -- allow for byte swapping 148 begin 149 --FDEC_BA98_7654_3210 150 S := 2#0011_0000_0111_0111#; 151 B := S16_2_B16( S ); 152 C := ( Character'Val(2#0011_0000#), Character'Val(2#0111_0111#) ); 153 D := ( Character'Val(2#0111_0111#), Character'Val(2#0011_0000#) ); 154 155 if (B /= C) and (B /= D) then 156 Report.Failed("Int => Chararray conversion failed"); 157 end if; 158 159 B := ( Character'Val(2#0011_1100#), Character'Val(2#0101_0101#) ); 160 S := B16_2_S16( B ); 161 T := 2#0011_1100_0101_0101#; 162 U := 2#0101_0101_0011_1100#; 163 164 if (S /= T) and (S /= U) then 165 Report.Failed("Chararray => Int conversion failed"); 166 end if; 167 168 end TC_Check_Case_2; 169 170end CD90001_0; 171 172------------------------------------------------------------------- CD90001 173 174with Report; 175with CD90001_0; 176 177procedure CD90001 is 178 179 Eight_NA : Boolean := False; 180 Sixteen_NA : Boolean := False; 181 182begin -- Main test procedure. 183 184 Report.Test ("CD90001", "Check that Unchecked_Conversion is supported " & 185 "and is reversible in appropriate cases" ); 186 Eight_Bit_Case: 187 begin 188 if CD90001_0.User_Enums'Size /= CD90001_0.Eight_Bits'Size then 189 Report.Comment("The sizes of the 8 bit types used in this test " 190 & "do not match" ); 191 Eight_NA := True; 192 elsif CD90001_0.User_Enums'Alignment /= CD90001_0.Eight_Bits'Alignment then 193 Report.Comment("The alignments of the 8 bit types used in this " 194 & "test do not match" ); 195 Eight_NA := True; 196 else 197 CD90001_0.TC_Check_Case_1; 198 end if; 199 200 exception 201 when Constraint_Error => 202 Report.Failed("Constraint_Error raised in 8 bit case"); 203 when others => 204 Report.Failed("Unexpected exception raised in 8 bit case"); 205 end Eight_Bit_Case; 206 207 Sixteen_Bit_Case: 208 begin 209 if CD90001_0.Signed_16'Size /= CD90001_0.Bits_16'Size then 210 Report.Comment("The sizes of the 16 bit types used in this test " 211 & "do not match" ); 212 Sixteen_NA := True; 213 elsif CD90001_0.Signed_16'Alignment /= CD90001_0.Bits_16'Alignment then 214 Report.Comment("The alignments of the 16 bit types used in this " 215 & "test do not match" ); 216 Sixteen_NA := True; 217 else 218 CD90001_0.TC_Check_Case_2; 219 end if; 220 221 exception 222 when Constraint_Error => 223 Report.Failed("Constraint_Error raised in 16 bit case"); 224 when others => 225 Report.Failed("Unexpected exception raised in 16 bit case"); 226 end Sixteen_Bit_Case; 227 228 if Eight_NA and Sixteen_NA then 229 Report.Not_Applicable("No cases in this test apply"); 230 end if; 231 232 Report.Result; 233 234end CD90001; 235