1-- CD92001.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 if X denotes a scalar object, X'Valid 28-- yields true if an only if the object denoted by X is normal and 29-- has a valid representation. 30-- 31-- TEST DESCRIPTION: 32-- Using Unchecked_Conversion, Image and Value attributes, combined 33-- with string manipulation, cause valid and invalid values to be 34-- stored in various objects. Check their validity with the 35-- attribute 'Valid. Invalid objects are created in a loop which 36-- performs a simplistic check to ensure that the values being used 37-- are indeed not valid, then assigns the value using an instance of 38-- Unchecked_Conversion. The creation of the tables of valid values 39-- is trivial. 40-- 41-- APPLICABILITY CRITERIA: 42-- All implementations must attempt to compile this test. 43-- 44-- For implementations validating against Systems Programming Annex (C): 45-- this test must execute and report PASSED. 46-- 47-- For implementations not validating against Annex C: 48-- this test may report compile time errors at one or more points 49-- indicated by "-- N/A => ERROR", in which case it may be graded as 50-- inapplicable. Otherwise, the test must execute and report PASSED. 51-- 52-- 53-- CHANGE HISTORY: 54-- 10 MAY 95 SAIC Initial version 55-- 07 MAY 96 SAIC Changed U_C to Ada.U_C for 2.1 56-- 05 JAN 99 RLB Added Component_Size clauses to compensate 57-- for the fact that there is no required size 58-- for either the enumeration or modular components. 59--! 60 61with Report; 62with Ada.Unchecked_Conversion; 63with System; 64procedure CD92001 is 65 66 type Sparse_Enumerated is 67 ( Help, Home, Page_Up, Del, EndK, 68 Page_Down, Up, Left, Down, Right ); 69 70 for Sparse_Enumerated use ( Help => 2, 71 Home => 4, 72 Page_Up => 8, 73 Del => 16, 74 EndK => 32, 75 Page_Down => 64, 76 Up => 128, 77 Left => 256, 78 Down => 512, 79 Right => 1024 ); 80 81 type Mod_10 is mod 10; 82 83 type Default_Enumerated is ( Zero, One, Two, Three, Four, 84 Five, Six, Seven, Eight, Nine, 85 Clear, '=', '/', '*', '-', 86 '+', Enter ); 87 for Default_Enumerated'Size use 8; 88 89 Default_Enumerated_Count : constant := 17; 90 91 type Mod_By_Enum_Items is mod Default_Enumerated_Count; 92 93 type Mod_Same_Size_As_Sparse_Enum is mod 2**12; 94 -- Sparse_Enumerated 'Size; 95 96 type Mod_Same_Size_As_Def_Enum is mod 2**8; 97 -- Default_Enumerated'Size; 98 99 subtype Test_Width is Positive range 1..100; 100 101 -- Note: There is no required relationship between 'Size and 'Component_Size, 102 -- so we must use component_size clauses here. 103 -- We use the following expressions to insure that the component size is a 104 -- multiple of the Storage_Unit. 105 Sparse_Component_Size : constant := ((Sparse_Enumerated'Size / System.Storage_Unit) + 106 Boolean'Pos((Sparse_Enumerated'Size mod System.Storage_Unit) /= 0)) * 107 System.Storage_Unit; 108 Default_Component_Size : constant := ((Default_Enumerated'Size / System.Storage_Unit) + 109 Boolean'Pos((Sparse_Enumerated'Size mod System.Storage_Unit) /= 0)) * 110 System.Storage_Unit; 111 112 type Sparse_Enum_Table is array(Test_Width) of Sparse_Enumerated; 113 for Sparse_Enum_Table'Component_Size use Sparse_Component_Size; -- N/A => ERROR. 114 type Def_Enum_Table is array(Test_Width) of Default_Enumerated; 115 for Def_Enum_Table'Component_Size use Default_Component_Size; -- N/A => ERROR. 116 117 type Sparse_Mod_Table is 118 array(Test_Width) of Mod_Same_Size_As_Sparse_Enum; 119 for Sparse_Mod_Table'Component_Size use Sparse_Component_Size; -- N/A => ERROR. 120 121 type Default_Mod_Table is 122 array(Test_Width) of Mod_Same_Size_As_Def_Enum; 123 for Default_Mod_Table'Component_Size use Default_Component_Size; -- N/A => ERROR. 124 125 function UC_Sparse_Mod_Enum is 126 new Ada.Unchecked_Conversion( Sparse_Mod_Table, Sparse_Enum_Table ); 127 128 function UC_Def_Mod_Enum is 129 new Ada.Unchecked_Conversion( Default_Mod_Table, Def_Enum_Table ); 130 131 Valid_Sparse_Values : Sparse_Enum_Table; 132 Valid_Def_Values : Def_Enum_Table; 133 134 Sample_Enum_Value_Table : Sparse_Mod_Table; 135 Sample_Def_Value_Table : Default_Mod_Table; 136 137 138 -- fill the Valid tables with valid values for conversion 139 procedure Fill_Valid is 140 K : Mod_10 := 0; 141 P : Mod_By_Enum_Items := 0; 142 begin 143 for I in Test_Width loop 144 Valid_Sparse_Values(I) := Sparse_Enumerated'Val( K ); 145 Valid_Def_Values(I) := Default_Enumerated'Val( Integer(P) ); 146 K := K +1; 147 P := P +1; 148 end loop; 149 end Fill_Valid; 150 151 -- fill the Sample tables with invalid values for conversion 152 procedure Fill_Invalid is 153 K : Mod_Same_Size_As_Sparse_Enum := 1; 154 P : Mod_Same_Size_As_Def_Enum := 1; 155 begin 156 for I in Test_Width loop 157 K := K +13; 158 if K mod 2 = 0 then -- oops, that would be a valid value 159 K := K +1; 160 end if; 161 if P = Mod_Same_Size_As_Def_Enum'Last 162 or P < Default_Enumerated_Count then -- that would be valid 163 P := Default_Enumerated_Count + 1; 164 else 165 P := P +1; 166 end if; 167 Sample_Enum_Value_Table(I) := K; 168 Sample_Def_Value_Table(I) := P; 169 end loop; 170 171 Valid_Sparse_Values := UC_Sparse_Mod_Enum(Sample_Enum_Value_Table); 172 Valid_Def_Values := UC_Def_Mod_Enum(Sample_Def_Value_Table); 173 174 end Fill_Invalid; 175 176 -- fill the tables with second set of valid values for conversion 177 procedure Refill_Valid is 178 K : Mod_10 := 0; 179 P : Mod_By_Enum_Items := 0; 180 181 Table : Array(Mod_10) of Mod_Same_Size_As_Sparse_Enum 182 := ( 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024 ); 183 184 begin 185 for I in Test_Width loop 186 Sample_Enum_Value_Table(I) := Table(K); 187 Sample_Def_Value_Table(I) := Mod_Same_Size_As_Def_Enum(P); 188 K := K +1; 189 P := P +1; 190 end loop; 191 Valid_Sparse_Values := UC_Sparse_Mod_Enum(Sample_Enum_Value_Table); 192 Valid_Def_Values := UC_Def_Mod_Enum(Sample_Def_Value_Table); 193 end Refill_Valid; 194 195 procedure Validate(Expect_Valid: Boolean) is 196 begin -- here's where we actually use the tested attribute 197 198 for K in Test_Width loop 199 if Valid_Sparse_Values(K)'Valid /= Expect_Valid then 200 Report.Failed("Expected 'Valid =" & Boolean'Image(Expect_Valid) 201 & " for Sparse item " & Integer'Image(K) ); 202 end if; 203 end loop; 204 205 for P in Test_Width loop 206 if Valid_Def_Values(P)'Valid /= Expect_Valid then 207 Report.Failed("Expected 'Valid =" & Boolean'Image(Expect_Valid) 208 & " for Default item " & Integer'Image(P) ); 209 end if; 210 end loop; 211 212 end Validate; 213 214begin -- Main test procedure. 215 216 Report.Test ("CD92001", "Check object attribute: X'Valid" ); 217 218 Fill_Valid; 219 Validate(True); 220 221 Fill_Invalid; 222 Validate(False); 223 224 Refill_Valid; 225 Validate(True); 226 227 Report.Result; 228 229end CD92001; 230