1-- C940012.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 a protected object can have discriminants 28-- 29-- TEST DESCRIPTION: 30-- Use a subset of the simulation of the freeway on-ramp described in 31-- c940005. In this case an array of access types is built with pointers 32-- to successive ramps. Each ramp has its Ramp_Number specified by 33-- discriminant and this corresponds to the index in the array. The test 34-- checks that the ramp numbers are assigned as expected then uses calls 35-- to procedures within the objects (ramps) to verify external calls to 36-- ensure the structures are valid. The external references within the 37-- protected objects are made via the index into the array. Routines 38-- which refer to the "previous" ramp and the "next" ramp are exercised. 39-- (Note: The first and last ramps are assumed to be dummies and no 40-- first/last condition code is included) 41-- 42-- 43-- CHANGE HISTORY: 44-- 06 Dec 94 SAIC ACVC 2.0 45-- 46--! 47 48 49with Report; 50 51 52procedure C940012 is 53 54 type Ramp_Index is range 1..4; 55 56 type Ramp; 57 type a_Ramp is access Ramp; 58 59 Ramp_Array : array (Ramp_Index) of a_Ramp; 60 61 -- Weighted load given to each potential problem area and accumulated 62 type Load_Factor is range 0..8; 63 Clear_Level : constant Load_Factor := 0; 64 Moderate_Level : constant Load_Factor := 3; 65 66 --================================================================ 67 -- Only the Routines that are used in this test are shown 68 -- 69 protected type Ramp (Ramp_In : Ramp_Index) is 70 71 function Ramp_Number return Ramp_Index; 72 function Local_Overload return Load_Factor; 73 function Next_Ramp_Overload return Load_Factor; 74 procedure Set_Local_Overload(Sensor_Level : Load_Factor); 75 procedure Notify; 76 77 private 78 79 Next_Ramp_Alert : Boolean := false; -- Next Ramp is in trouble? 80 81 -- Current state of the various Sample Points 82 Local_State : Load_Factor := Clear_Level; 83 84 end Ramp; 85 --================================================================ 86 protected body Ramp is 87 88 function Ramp_Number return Ramp_Index is 89 begin 90 return Ramp_In; 91 end Ramp_Number; 92 93 -- These Set/Clear routines are triggered by real-time sensors that 94 -- reflect traffic state 95 procedure Set_Local_Overload(Sensor_Level : Load_Factor) is 96 begin 97 if Local_State = Clear_Level then 98 -- Notify "previous" ramp to check this one for current state. 99 -- Subsequent changes in state will not send an alert 100 -- When the situation clears another routine performs the 101 -- all_clear notification. (not shown) 102 Ramp_Array(Ramp_In - 1).Notify; -- index to previous ramp 103 end if; 104 Local_State := Sensor_Level; 105 null; --::::: Start local meter if not already started 106 end; 107 108 function Local_Overload return Load_Factor is 109 begin 110 return Local_State; 111 end Local_Overload; 112 113 -- This is notification from the next ramp that it is in 114 -- overload. With this provision we only need to sample the next 115 -- ramp during adverse conditions. 116 procedure Notify is 117 begin 118 Next_Ramp_Alert := true; 119 end Notify; 120 121 function Next_Ramp_Overload return Load_Factor is 122 begin 123 if Next_Ramp_Alert then 124 -- Get next ramp's current state 125 return Ramp_Array(Ramp_In + 1).Local_Overload; 126 else 127 return Clear_Level; 128 end if; 129 end Next_Ramp_Overload; 130 end Ramp; 131 --================================================================ 132 133begin 134 135 136 Report.Test ("C940012", "Check that a protected object " & 137 "can have discriminants"); 138 139 -- Build the ramps and populate the ramp array 140 for i in Ramp_Index loop 141 Ramp_Array(i) := new Ramp (i); 142 end loop; 143 144 -- Test driver. This is ALL test control code 145 146 -- Check the assignment of the index 147 for i in Ramp_Index loop 148 if Ramp_Array(i).Ramp_Number /= i then 149 Report.Failed ("Ramp_Number assignment incorrect"); 150 end if; 151 end loop; 152 153 -- Simulate calls to the protected functions and procedures 154 -- external calls. (do not call the "dummy" end ramps) 155 156 -- Simple Call 157 if Ramp_Array(2).Next_Ramp_Overload /= Clear_level then 158 Report.Failed ("Primary call incorrect"); 159 end if; 160 161 -- Call which results in an external procedure call via the array 162 -- index from within the protected object 163 Ramp_Array(3).Set_Local_Overload (Moderate_Level); 164 165 -- Call which results in an external function call via the array 166 -- index from within the protected object 167 if Ramp_Array(2).Next_Ramp_Overload /= Moderate_level then 168 Report.Failed ("Secondary call incorrect"); 169 end if; 170 171 172 Report.Result; 173 174end C940012; 175