1-- C3A1001.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 full type completing a type with no discriminant part 28-- or an unknown discriminant part may have explicitly declared or 29-- inherited discriminants. 30-- Check for cases where the types are records and protected types. 31-- 32-- TEST DESCRIPTION: 33-- Declare two groups of incomplete types: one group with no discriminant 34-- part and one group with unknown discriminant part. Both groups of 35-- incomplete types are completed with both explicit and inherited 36-- discriminants. Discriminants for record and protected types are 37-- declared with default and non default values. 38-- In the main program, verify that objects of both groups of incomplete 39-- types can be created by default values or by assignments. 40-- 41-- 42-- CHANGE HISTORY: 43-- 11 Oct 95 SAIC Initial prerelease version. 44-- 11 Nov 96 SAIC Revised for version 2.1. 45-- 46--! 47 48package C3A1001_0 is 49 50 type Incomplete1 (<>); -- unknown discriminant 51 52 type Incomplete2; -- no discriminant 53 54 type Incomplete3 (<>); -- unknown discriminant 55 56 type Incomplete4; -- no discriminant 57 58 type Incomplete5 (<>); -- unknown discriminant 59 60 type Incomplete6; -- no discriminant 61 62 type Incomplete8; -- no discriminant 63 64 subtype Small_Int is Integer range 1 .. 10; 65 66 type Enu_Type is (M, F); 67 68 type Incomplete1 (Disc : Enu_Type) is -- unknown discriminant/ 69 record -- explicit discriminant 70 case Disc is 71 when M => MInteger : Small_Int := 3; 72 when F => FInteger : Small_Int := 8; 73 end case; 74 end record; 75 76 type Incomplete2 (Disc : Small_Int := 8) is -- no discriminant/ 77 record -- explicit discriminant 78 ID : String (1 .. Disc) := "Plymouth"; 79 end record; 80 81 type Incomplete3 is new Incomplete2; -- unknown discriminant/ 82 -- inherited discriminant 83 84 type Incomplete4 is new Incomplete2; -- no discriminant/ 85 -- inherited discriminant 86 87 protected type Incomplete5 -- unknown discriminant/ 88 (Disc : Enu_Type) is -- explicit discriminant 89 function Get_Priv_Val return Enu_Type; 90 private 91 Enu_Obj : Enu_Type := Disc; 92 end Incomplete5; 93 94 protected type Incomplete6 -- no discriminant/ 95 (Disc : Small_Int := 1) is -- explicit discriminant 96 function Get_Priv_Val return Small_Int; -- with default 97 private 98 Num : Small_Int := Disc; 99 end Incomplete6; 100 101 type Incomplete8 (Disc : Small_Int) is -- no discriminant/ 102 record -- explicit discriminant 103 Str : String (1 .. Disc); -- no default 104 end record; 105 106 type Incomplete9 is new Incomplete8; 107 108 function Return_String (S : String) return String; 109 110end C3A1001_0; 111 112 --==================================================================-- 113 114with Report; 115 116package body C3A1001_0 is 117 118 protected body Incomplete5 is 119 120 function Get_Priv_Val return Enu_Type is 121 begin 122 return Enu_Obj; 123 end Get_Priv_Val; 124 125 end Incomplete5; 126 127 ---------------------------------------------------------------------- 128 protected body Incomplete6 is 129 130 function Get_Priv_Val return Small_Int is 131 begin 132 return Num; 133 end Get_Priv_Val; 134 135 end Incomplete6; 136 137 ---------------------------------------------------------------------- 138 function Return_String (S : String) return String is 139 begin 140 if Report.Ident_Bool(True) = True then 141 return S; 142 end if; 143 144 return S; 145 end Return_String; 146 147end C3A1001_0; 148 149 --==================================================================-- 150 151with Report; 152 153with C3A1001_0; 154use C3A1001_0; 155 156procedure C3A1001 is 157 158 -- Discriminant value comes from default. 159 160 Incomplete2_Obj_1 : Incomplete2; 161 162 Incomplete4_Obj_1 : Incomplete4; 163 164 Incomplete6_Obj_1 : Incomplete6; 165 166 -- Discriminant value comes from explicit constraint. 167 168 Incomplete1_Obj_1 : Incomplete1 (F); 169 170 Incomplete5_Obj_1 : Incomplete5 (M); 171 172 Incomplete6_Obj_2 : Incomplete6 (2); 173 174 -- Discriminant value comes from assignment. 175 176 Incomplete3_Obj_1 : Incomplete3 := (Disc => 6, ID => "Sentra"); 177 178 Incomplete1_Obj_2 : Incomplete1 := (Disc => M, MInteger => 9); 179 180 Incomplete2_Obj_2 : Incomplete2 := (Disc => 5, ID => "Buick"); 181 182begin 183 184 Report.Test ("C3A1001", "Check that the full type completing a type " & 185 "with no discriminant part or an unknown discriminant " & 186 "part may have explicitly declared or inherited " & 187 "discriminants. Check for cases where the types are " & 188 "records and protected types"); 189 190 -- Check the initial values. 191 192 if (Incomplete2_Obj_1.Disc /= 8) or 193 (Incomplete2_Obj_1.ID /= "Plymouth") then 194 Report.Failed ("Wrong initial values for Incomplete2_Obj_1"); 195 end if; 196 197 if (Incomplete4_Obj_1.Disc /= 8) or 198 (Incomplete4_Obj_1.ID /= "Plymouth") then 199 Report.Failed ("Wrong initial values for Incomplete4_Obj_1"); 200 end if; 201 202 if (Incomplete6_Obj_1.Disc /= 1) or 203 (Incomplete6_Obj_1.Get_Priv_Val /= 1) then 204 Report.Failed ("Wrong initial value for Incomplete6_Obj_1"); 205 end if; 206 207 -- Check the explicit values. 208 209 if (Incomplete1_Obj_1.Disc /= F) or 210 (Incomplete1_Obj_1.FInteger /= 8) then 211 Report.Failed ("Wrong values for Incomplete1_Obj_1"); 212 end if; 213 214 if (Incomplete5_Obj_1.Disc /= M) or 215 (Incomplete5_Obj_1.Get_Priv_Val /= M) then 216 Report.Failed ("Wrong value for Incomplete5_Obj_1"); 217 end if; 218 219 if (Incomplete6_Obj_2.Disc /= 2) or 220 (Incomplete6_Obj_2.Get_Priv_Val /= 2) then 221 Report.Failed ("Wrong value for Incomplete6_Obj_2"); 222 end if; 223 224 -- Check the assigned values. 225 226 if (Incomplete3_Obj_1.Disc /= 6) or 227 (Incomplete3_Obj_1.ID /= "Sentra") then 228 Report.Failed ("Wrong values for Incomplete3_Obj_1"); 229 end if; 230 231 if (Incomplete1_Obj_2.Disc /= M) or 232 (Incomplete1_Obj_2.MInteger /= 9) then 233 Report.Failed ("Wrong values for Incomplete1_Obj_2"); 234 end if; 235 236 if (Incomplete2_Obj_2.Disc /= 5) or 237 (Incomplete2_Obj_2.ID /= "Buick") then 238 Report.Failed ("Wrong values for Incomplete2_Obj_2"); 239 end if; 240 241 -- Make sure that assignments work without problems. 242 243 Incomplete1_Obj_1.FInteger := 1; 244 245 -- Avoid optimization (dead variable removal of FInteger): 246 247 if Incomplete1_Obj_1.FInteger /= Report.Ident_Int(1) 248 then 249 Report.Failed ("Wrong value stored in Incomplete1_Obj_1.FInteger"); 250 end if; 251 252 Incomplete2_Obj_1.ID := Return_String ("12345678"); 253 254 -- Avoid optimization (dead variable removal of ID) 255 256 if Incomplete2_Obj_1.ID /= Return_String ("12345678") 257 then 258 Report.Failed ("Wrong values for Incomplete8_Obj_1.ID"); 259 end if; 260 261 Incomplete4_Obj_1.ID := Return_String ("87654321"); 262 263 -- Avoid optimization (dead variable removal of ID) 264 265 if Incomplete4_Obj_1.ID /= Return_String ("87654321") 266 then 267 Report.Failed ("Wrong values for Incomplete4_Obj_1.ID"); 268 end if; 269 270 271 Test1: 272 declare 273 274 Incomplete8_Obj_1 : Incomplete8 (10); 275 276 begin 277 Incomplete8_Obj_1.Str := "Merry Xmas"; 278 279 -- Avoid optimization (dead variable removal of Str): 280 281 if Return_String (Incomplete8_Obj_1.Str) /= "Merry Xmas" 282 then 283 Report.Failed ("Wrong values for Incomplete8_Obj_1.Str"); 284 end if; 285 286 exception 287 when Constraint_Error => 288 Report.Failed ("Constraint_Error raised in Incomplete8_Obj_1"); 289 290 end Test1; 291 292 Test2: 293 declare 294 295 Incomplete8_Obj_2 : Incomplete8 (5); 296 297 begin 298 Incomplete8_Obj_2.Str := "Happy"; 299 300 -- Avoid optimization (dead variable removal of Str): 301 302 if Return_String (Incomplete8_Obj_2.Str) /= "Happy" 303 then 304 Report.Failed ("Wrong values for Incomplete8_Obj_1.Str"); 305 end if; 306 307 exception 308 when Constraint_Error => 309 Report.Failed ("Constraint_Error raised in Incomplete8_Obj_2"); 310 311 end Test2; 312 313 Report.Result; 314 315end C3A1001; 316