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