OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c392c05.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- 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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.