1-- C360002.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 modular types may be used as array indices. 28-- 29-- Check that if aliased appears in the component_definition of an 30-- array_type that each component of the array is aliased. 31-- 32-- Check that references to aliased array objects produce correct 33-- results, and that out-of-bounds indexing correctly produces 34-- Constraint_Error. 35-- 36-- TEST DESCRIPTION: 37-- This test defines several array types and subtypes indexed by modular 38-- types; some aliased some not, some with aliased components, some not. 39-- 40-- It then checks that assignments move the correct data. 41-- 42-- 43-- CHANGE HISTORY: 44-- 28 SEP 95 SAIC Initial version 45-- 23 APR 96 SAIC Doc fixes, fixed constrained/unconstrained conflict 46-- 13 FEB 97 PWB.CTA Removed illegal declarations and affected code 47--! 48 49------------------------------------------------------------------- C360002 50 51with Report; 52 53procedure C360002 is 54 55 Verbose : Boolean := Report.Ident_Bool( False ); 56 57 type Mod_128 is mod 128; 58 59 function Ident_128( I: Integer ) return Mod_128 is 60 begin 61 return Mod_128( Report.Ident_Int( I ) ); 62 end Ident_128; 63 64 type Unconstrained_Array 65 is array( Mod_128 range <> ) of Integer; 66 67 type Unconstrained_Array_Aliased 68 is array( Mod_128 range <> ) of aliased Integer; 69 70 type Access_All_Unconstrained_Array 71 is access all Unconstrained_Array; 72 73 type Access_All_Unconstrained_Array_Aliased 74 is access all Unconstrained_Array_Aliased; 75 76 subtype Array_01_10 77 is Unconstrained_Array(01..10); 78 79 subtype Array_11_20 80 is Unconstrained_Array(11..20); 81 82 subtype Array_Aliased_01_10 83 is Unconstrained_Array_Aliased(01..10); 84 85 subtype Array_Aliased_11_20 86 is Unconstrained_Array_Aliased(11..20); 87 88 subtype Access_All_01_10_Array 89 is Access_All_Unconstrained_Array(01..10); 90 91 subtype Access_All_01_10_Array_Aliased 92 is Access_All_Unconstrained_Array_Aliased(01..10); 93 94 subtype Access_All_11_20_Array 95 is Access_All_Unconstrained_Array(11..20); 96 97 subtype Access_All_11_20_Array_Aliased 98 is Access_All_Unconstrained_Array_Aliased(11..20); 99 100 101-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- 102 103 -- these 'filler' functions create unique values for every element that 104 -- is used and/or tested in this test. 105 106 Well_Bottom : Integer := 0; 107 108 function Filler( Size : Mod_128 ) return Unconstrained_Array is 109 It : Unconstrained_Array( 0..Size-1 ); 110 begin 111 for Eyes in It'Range loop 112 It(Eyes) := Integer( Eyes ) + Well_Bottom; 113 end loop; 114 Well_Bottom := Well_Bottom + It'Length; 115 return It; 116 end Filler; 117 118 function Filler( Size : Mod_128 ) return Unconstrained_Array_Aliased is 119 It : Unconstrained_Array_Aliased( 0..Size-1 ); 120 begin 121 for Ayes in It'Range loop 122 It(Ayes) := Integer( Ayes ) + Well_Bottom; 123 end loop; 124 Well_Bottom := Well_Bottom + It'Length; 125 return It; 126 end Filler; 127 128-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- 129 130 An_Integer : Integer; 131 132 type AAI is access all Integer; 133 134 An_Integer_Access : AAI; 135 136 Array_Item_01_10 : Array_01_10 := Filler(10); -- 0..9 137 138 Array_Item_11_20 : Array_11_20 := Filler(10); -- 10..19 (sliding) 139 140 Array_Aliased_Item_01_10 : Array_Aliased_01_10 := Filler(10); -- 20..29 141 142 Array_Aliased_Item_11_20 : Array_Aliased_11_20 := Filler(10); -- 30..39 143 144 Aliased_Array_Item_01_10 : aliased Array_01_10 := Filler(10); -- 40..49 145 146 Aliased_Array_Item_11_20 : aliased Array_11_20 := Filler(10); -- 50..59 147 148 Aliased_Array_Aliased_Item_01_10 : aliased Array_Aliased_01_10 149 := Filler(10); -- 60..69 150 151 Aliased_Array_Aliased_Item_11_20 : aliased Array_Aliased_11_20 152 := Filler(10); -- 70..79 153 154 Check_Item : Access_All_Unconstrained_Array; 155 156 Check_Aliased_Item : Access_All_Unconstrained_Array_Aliased; 157 158-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- 159 160 procedure Fail( Message : String; CI, SB : Integer ) is 161 begin 162 Report.Failed("Wrong value passed " & Message); 163 if Verbose then 164 Report.Comment("got" & Integer'Image(CI) & 165 " should be" & Integer'Image(SB) ); 166 end if; 167 end Fail; 168 169 procedure Check_Array_01_10( Checked_Item : Array_01_10; 170 Low_SB : Integer ) is 171 begin 172 for Index in Checked_Item'Range loop 173 if (Checked_Item(Index) /= (Low_SB +Integer(Index)-1)) then 174 Fail("unaliased 1..10", Checked_Item(Index), 175 (Low_SB +Integer(Index)-1)); 176 end if; 177 end loop; 178 end Check_Array_01_10; 179 180 procedure Check_Array_11_20( Checked_Item : Array_11_20; 181 Low_SB : Integer ) is 182 begin 183 for Index in Checked_Item'Range loop 184 if (Checked_Item(Index) /= (Low_SB +Integer(Index)-11)) then 185 Fail("unaliased 11..20", Checked_Item(Index), 186 (Low_SB +Integer(Index)-11)); 187 end if; 188 end loop; 189 end Check_Array_11_20; 190 191 procedure Check_Single_Integer( The_Integer, SB : Integer; 192 Message : String ) is 193 begin 194 if The_Integer /= SB then 195 Report.Failed("Wrong integer value for " & Message ); 196 end if; 197 end Check_Single_Integer; 198 199-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- 200 201begin -- Main test procedure. 202 203 Report.Test ("C360002", "Check that modular types may be used as array " & 204 "indices. Check that if aliased appears in " & 205 "the component_definition of an array_type that " & 206 "each component of the array is aliased. Check " & 207 "that references to aliased array objects " & 208 "produce correct results, and that out of bound " & 209 "references to aliased objects correctly " & 210 "produce Constraint_Error" ); 211 -- start with checks that the Filler assignments produced the expected 212 -- result. This is a "case 0" test to check that nothing REALLY surprising 213 -- is happening 214 215 Check_Array_01_10( Array_Item_01_10, 0 ); 216 Check_Array_11_20( Array_Item_11_20, 10 ); 217 218 -- check that having the variable aliased makes no difference 219 Check_Array_01_10( Aliased_Array_Item_01_10, 40 ); 220 Check_Array_11_20( Aliased_Array_Item_11_20, 50 ); 221 222 -- now check that conversion between array types where the only 223 -- difference in the definitions is that the components are aliased works 224 225 Check_Array_01_10( Unconstrained_Array( Array_Aliased_Item_01_10 ), 20 ); 226 Check_Array_11_20( Unconstrained_Array( Array_Aliased_Item_11_20 ), 30 ); 227 228 -- check that conversion of an aliased object with aliased components 229 -- also works 230 231 Check_Array_01_10( Unconstrained_Array( Aliased_Array_Aliased_Item_01_10 ), 232 60 ); 233 Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ), 234 70 ); 235 236 -- check that the bounds will slide 237 238 Check_Array_01_10( Array_01_10( Array_Item_11_20 ), 10 ); 239 Check_Array_11_20( Array_11_20( Array_Item_01_10 ), 0 ); 240 241 -- point at some of the components and check them 242 243 An_Integer_Access := Array_Aliased_Item_01_10(5)'Access; 244 245 Check_Single_Integer( An_Integer_Access.all, 24, 246 "Aliased component 'Access"); 247 248 An_Integer_Access := Aliased_Array_Aliased_Item_01_10(7)'Access; 249 250 Check_Single_Integer( An_Integer_Access.all, 66, 251 "Aliased Aliased component 'Access"); 252 253 -- check some assignments 254 255 Array_Item_01_10 := Aliased_Array_Item_01_10; 256 Check_Array_01_10( Array_Item_01_10, 40 ); 257 258 Aliased_Array_Item_01_10 := Aliased_Array_Item_11_20(11..20); 259 Check_Array_01_10( Aliased_Array_Item_01_10, 50 ); 260 261 Aliased_Array_Aliased_Item_11_20(11..20) 262 := Aliased_Array_Aliased_Item_01_10; 263 Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ), 264 60 ); 265 266 Report.Result; 267 268end C360002; 269