|
111
|
1 -- C392C05.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 for a call to a dispatching subprogram the subprogram
|
|
|
28 -- body which is executed is determined by the controlling tag for
|
|
|
29 -- the case where the call has statically tagged controlling operands
|
|
|
30 -- of the type T. Check this for various operands of tagged types:
|
|
|
31 -- objects (declared or allocated), formal parameters, view conversions,
|
|
|
32 -- function calls (both primitive and non-primitive).
|
|
|
33 --
|
|
|
34 -- TEST DESCRIPTION:
|
|
|
35 -- This test uses foundation F392C00 to test the usages of statically
|
|
|
36 -- tagged objects and values. The calls to Validate indicate the
|
|
|
37 -- expected sequence of procedure calls since the previous call to
|
|
|
38 -- Validate. Static tags can be determined at compile time, and
|
|
|
39 -- hence this is a test of correct overload resolution for tagged types.
|
|
|
40 -- A clever compiler which unrolls loops and does path analysis on
|
|
|
41 -- access values will be able to perform the same kind of determination
|
|
|
42 -- for all of the code in this test.
|
|
|
43 --
|
|
|
44 -- TEST FILES:
|
|
|
45 -- The following files comprise this test:
|
|
|
46 --
|
|
|
47 -- F392C00.A (foundation code)
|
|
|
48 -- C392C05.A
|
|
|
49 --
|
|
|
50 --
|
|
|
51 -- CHANGE HISTORY:
|
|
|
52 -- 06 Dec 94 SAIC ACVC 2.0
|
|
|
53 -- 19 Dec 94 SAIC Removed RM references from objective text.
|
|
|
54 -- 24 Oct 95 SAIC Updated for ACVC 2.0.1
|
|
|
55 -- 13 Feb 97 PWB.CTA Corrected assumption that "or" operands are
|
|
|
56 -- evaluated in textual order.
|
|
|
57 --!
|
|
|
58
|
|
|
59 with Report;
|
|
|
60 with TCTouch;
|
|
|
61 with F392C00_1;
|
|
|
62 procedure C392C05 is -- Hardware_Store
|
|
|
63
|
|
|
64 package Switch renames F392C00_1;
|
|
|
65
|
|
|
66 subtype Switch_Class is Switch.Toggle'Class;
|
|
|
67
|
|
|
68 type Reference is access all Switch_Class;
|
|
|
69
|
|
|
70 A_Switch : aliased Switch.Toggle;
|
|
|
71 A_Dimmer : aliased Switch.Dimmer;
|
|
|
72 An_Autodim : aliased Switch.Auto_Dimmer;
|
|
|
73
|
|
|
74 type Light_Bank is array(Positive range <>) of Reference;
|
|
|
75
|
|
|
76 Lamps : Light_Bank(1..3);
|
|
|
77
|
|
|
78 begin -- Main test procedure.
|
|
|
79
|
|
|
80 Report.Test ("C392C05", "Check that a dispatching subprogram call is "
|
|
|
81 & "determined by the controlling tag for statically "
|
|
|
82 & "tagged controlling operands" );
|
|
|
83
|
|
|
84 -- Check use of static tagged declared objects,
|
|
|
85 -- and static tagged formal parameters
|
|
|
86 -- Must call correct version of flip based on type of controlling op.
|
|
|
87
|
|
|
88 -- Turn on the lights!
|
|
|
89
|
|
|
90 Switch.Flip( A_Switch );
|
|
|
91 TCTouch.Validate( "A", "Declared Toggle" );
|
|
|
92
|
|
|
93 Switch.Flip( A_Dimmer );
|
|
|
94 TCTouch.Validate( "GBA", "Declared Dimmer" );
|
|
|
95
|
|
|
96 Switch.Flip( An_Autodim );
|
|
|
97 TCTouch.Validate( "KGBA", "Declared Auto_Dimmer" );
|
|
|
98
|
|
|
99 Lamps(1) := new Switch.Toggle;
|
|
|
100 Lamps(2) := new Switch.Dimmer;
|
|
|
101 Lamps(3) := new Switch.Auto_Dimmer;
|
|
|
102
|
|
|
103 -- Check use of static tagged allocated objects,
|
|
|
104 -- and static tagged formal parameters in a loop which may dynamically
|
|
|
105 -- dispatch. If an optimizer unrolls the loop, it may then be statically
|
|
|
106 -- determined, and no dispatching will occur. Either interpretation is
|
|
|
107 -- correct.
|
|
|
108 for Knob in Lamps'Range loop
|
|
|
109 Switch.Flip( Lamps(Knob).all );
|
|
|
110 end loop;
|
|
|
111 TCTouch.Validate( "AGBAKGBA", "Allocated Objects" );
|
|
|
112
|
|
|
113 -- Check use of static tagged declared objects,
|
|
|
114 -- calling non-primitive functions.
|
|
|
115 if not Switch.TC_Non_Disp( A_Switch ) then
|
|
|
116 Report.Failed( "Bad Value 1" );
|
|
|
117 end if;
|
|
|
118 TCTouch.Validate( "X", "Nonprimitive Function" );
|
|
|
119
|
|
|
120 if not Switch.TC_Non_Disp( A_Dimmer ) then
|
|
|
121 Report.Failed( "Bad Value 2" );
|
|
|
122 end if;
|
|
|
123 TCTouch.Validate( "Y", "Nonprimitive Function" );
|
|
|
124
|
|
|
125 if not Switch.TC_Non_Disp( An_Autodim ) then
|
|
|
126 Report.Failed( "Bad Value 3" );
|
|
|
127 end if;
|
|
|
128 TCTouch.Validate( "Z", "Nonprimitive Function" );
|
|
|
129
|
|
|
130 A_Switch := Switch.Create;
|
|
|
131 A_Dimmer := Switch.Create;
|
|
|
132 An_Autodim := Switch.Create;
|
|
|
133 TCTouch.Validate( "123", "Primitive Function" );
|
|
|
134
|
|
|
135 -- View conversions
|
|
|
136 Switch.Brighten( An_Autodim, 50 );
|
|
|
137
|
|
|
138 Switch.Flip( Switch.Toggle( A_Switch ) );
|
|
|
139 Switch.Flip( Switch.Toggle( A_Dimmer ) );
|
|
|
140 Switch.Flip( Switch.Dimmer( An_Autodim ) );
|
|
|
141 TCTouch.Validate( "DAAGBA", "View Conversions" );
|
|
|
142
|
|
|
143 -- statically tagged controlling operands (specific types) provided to
|
|
|
144 -- class-wide functions
|
|
|
145 if Switch.On( A_Switch )
|
|
|
146 or Switch.On( A_Dimmer )
|
|
|
147 or Switch.On( An_Autodim ) then
|
|
|
148 Report.Failed( "Bad Value 4" );
|
|
|
149 end if;
|
|
|
150 TCTouch.Validate( "BBB", "Class-wide" );
|
|
|
151
|
|
|
152 -- statically tagged controlling operands qualified expressions provided to
|
|
|
153 -- primitive functions, also using context to determine call to a
|
|
|
154 -- class-wide function.
|
|
|
155 if Switch.Off( Switch.Toggle'( Switch.Create ) )
|
|
|
156 or else Switch.Off( Switch.Dimmer'( Switch.Create ) )
|
|
|
157 or else Switch.Off( Switch.Auto_Dimmer'( Switch.Create ) ) then
|
|
|
158 Report.Failed( "Bad Value 5" );
|
|
|
159 end if;
|
|
|
160 TCTouch.Validate( "1C2C3C", "Qualified Expression/Class-Wide" );
|
|
|
161
|
|
|
162 Report.Result;
|
|
|
163
|
|
|
164 end C392C05;
|
