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
59with Report;
60with TCTouch;
61with F392C00_1;
62procedure 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
78begin  -- 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
164end C392C05;
165