1-- C3A1002.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 tagged records and task 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 task types are declared with both 37-- default and non default values. Discriminants for tagged types are 38-- only declared without default values. 39-- In the main program, verify that objects of both groups of incomplete 40-- types can be created by default values or by assignments. 41-- 42-- 43-- CHANGE HISTORY: 44-- 23 Oct 95 SAIC Initial prerelease version. 45-- 19 Oct 96 SAIC ACVC 2.1: modified test description. Initialized 46-- Int_Val. 47-- 48--! 49 50package C3A1002_0 is 51 52 subtype Small_Int is Integer range 1 .. 15; 53 54 type Enu_Type is (M, F); 55 56 type Tag_Type is tagged 57 record 58 I : Small_Int := 1; 59 end record; 60 61 type NTag_Type (D : Small_Int) is new Tag_Type with 62 record 63 S : String (1 .. D) := "Aloha"; 64 end record; 65 66 type Incomplete1; -- no discriminant 67 68 type Incomplete2 (<>); -- unknown discriminant 69 70 type Incomplete3; -- no discriminant 71 72 type Incomplete4 (<>); -- unknown discriminant 73 74 type Incomplete5; -- no discriminant 75 76 type Incomplete6 (<>); -- unknown discriminant 77 78 type Incomplete1 (D1 : Enu_Type) is tagged -- no discriminant/ 79 record -- explicit discriminant 80 case D1 is 81 when M => MInteger : Small_Int := 9; 82 when F => FInteger : Small_Int := 8; 83 end case; 84 end record; 85 86 type Incomplete2 (D2 : Small_Int) is new -- unknown discriminant/ 87 Incomplete1 (D1 => F) with record -- explicit discriminant 88 ID : String (1 .. D2) := "ACVC95"; 89 end record; 90 91 type Incomplete3 is new -- no discriminant/ 92 NTag_Type with record -- inherited discriminant 93 E : Enu_Type := M; 94 end record; 95 96 type Incomplete4 is new -- unknown discriminant/ 97 NTag_Type (D => 3) with record -- inherited discriminant 98 E : Enu_Type := F; 99 end record; 100 101 task type Incomplete5 (D5 : Enu_Type) is -- no discriminant/ 102 entry Read_Disc (P : out Enu_Type); -- explicit discriminant 103 end Incomplete5; 104 105 task type Incomplete6 106 (D6 : Small_Int := 4) is -- unknown discriminant/ 107 entry Read_Int (P : out Small_Int); -- explicit discriminant 108 end Incomplete6; 109 110end C3A1002_0; 111 112 --==================================================================-- 113 114package body C3A1002_0 is 115 116 task body Incomplete5 is 117 begin 118 select 119 accept Read_Disc (P : out Enu_Type) do 120 P := D5; 121 end Read_Disc; 122 or 123 terminate; 124 end select; 125 126 end Incomplete5; 127 128 ---------------------------------------------------------------------- 129 task body Incomplete6 is 130 begin 131 select 132 accept Read_Int (P : out Small_Int) do 133 P := D6; 134 end Read_Int; 135 or 136 terminate; 137 end select; 138 139 end Incomplete6; 140 141end C3A1002_0; 142 143 --==================================================================-- 144 145with Report; 146 147with C3A1002_0; 148use C3A1002_0; 149 150procedure C3A1002 is 151 152 Enum_Val : Enu_Type := M; 153 154 Int_Val : Small_Int := 15; 155 156 -- Discriminant value comes from default. 157 158 Incomplete6_Obj_1 : Incomplete6; 159 160 -- Discriminant value comes from explicit constraint. 161 162 Incomplete1_Obj_1 : Incomplete1 (M); 163 164 Incomplete2_Obj_1 : Incomplete2 (6); 165 166 Incomplete5_Obj_1 : Incomplete5 (F); 167 168 Incomplete6_Obj_2 : Incomplete6 (7); 169 170 -- Discriminant value comes from assignment. 171 172 Incomplete1_Obj_2 : Incomplete1 173 := (F, 12); 174 175 Incomplete3_Obj_1 : Incomplete3 176 := (D => 2, S => "Hi", I => 10, E => F); 177 178 Incomplete4_Obj_1 : Incomplete4 179 := (E => M, D => 3, S => "Bye", I => 14); 180 181begin 182 183 Report.Test ("C3A1002", "Check that the full type completing a type " & 184 "with no discriminant part or an unknown discriminant " & 185 "part may have explicitly declared or inherited " & 186 "discriminants. Check for cases where the types are " & 187 "tagged records and task types"); 188 189 -- Check the initial values. 190 191 if (Incomplete6_Obj_1.D6 /= 4) then 192 Report.Failed ("Wrong initial value for Incomplete6_Obj_1"); 193 end if; 194 195 -- Check the explicit values. 196 197 if (Incomplete1_Obj_1.D1 /= M) or 198 (Incomplete1_Obj_1.MInteger /= 9) then 199 Report.Failed ("Wrong values for Incomplete1_Obj_1"); 200 end if; 201 202 if (Incomplete2_Obj_1.D2 /= 6) or 203 (Incomplete2_Obj_1.FInteger /= 8) or 204 (Incomplete2_Obj_1.ID /= "ACVC95") then 205 Report.Failed ("Wrong values for Incomplete2_Obj_1"); 206 end if; 207 208 if (Incomplete5_Obj_1.D5 /= F) then 209 Report.Failed ("Wrong value for Incomplete5_Obj_1"); 210 end if; 211 212 Incomplete5_Obj_1.Read_Disc (Enum_Val); 213 214 if (Enum_Val /= F) then 215 Report.Failed ("Wrong value for Enum_Val"); 216 end if; 217 218 if (Incomplete6_Obj_2.D6 /= 7) then 219 Report.Failed ("Wrong value for Incomplete6_Obj_2"); 220 end if; 221 222 Incomplete6_Obj_1.Read_Int (Int_Val); 223 224 if (Int_Val /= 4) then 225 Report.Failed ("Wrong value for Int_Val"); 226 end if; 227 228 -- Check the assigned values. 229 230 if (Incomplete1_Obj_2.D1 /= F) or 231 (Incomplete1_Obj_2.FInteger /= 12) then 232 Report.Failed ("Wrong values for Incomplete1_Obj_2"); 233 end if; 234 235 if (Incomplete3_Obj_1.D /= 2 ) or 236 (Incomplete3_Obj_1.I /= 10) or 237 (Incomplete3_Obj_1.E /= F ) or 238 (Incomplete3_Obj_1.S /= "Hi") then 239 Report.Failed ("Wrong values for Incomplete3_Obj_1"); 240 end if; 241 242 if (Incomplete4_Obj_1.E /= M ) or 243 (Incomplete4_Obj_1.D /= 3) or 244 (Incomplete4_Obj_1.S /= "Bye") or 245 (Incomplete4_Obj_1.I /= 14) then 246 Report.Failed ("Wrong values for Incomplete4_Obj_1"); 247 end if; 248 249 Report.Result; 250 251end C3A1002; 252