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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c390a022.am] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C390A022.AM
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 nonprivate tagged type declared in a package specification
28
--      may be extended with a record extension in a different package
29
--      specification, and that this record extension may in turn be extended
30
--      by a private extension in a third package.
31
--
32
--      Check that each derivative inherits the user-defined primitive
33
--      subprograms of its parent (including those that its parent inherited),
34
--      that it may override these inherited primitive subprograms, and that it
35
--      may also declare its own primitive subprograms.
36
--
37
--      Check that predefined equality operators are defined for the tagged
38
--      type and its derivatives.
39
--
40
--      Check that type conversion is defined from a type extension to its
41
--      parent, and that this parent itself may be a type extension.
42
--
43
-- TEST DESCRIPTION:
44
--      Declare a root tagged type and two associated primitive subprograms
45
--      in a package specification (foundation code).
46
--
47
--      Extend the root type with a record extension in a different package
48
--      specification. Declare a new primitive subprogram for the extension,
49
--      and override one of the two inherited subprograms. Within the
50
--      overriding subprogram, utilize type conversion to call the parent's
51
--      implementation of the same subprogram. Also within the overriding
52
--      subprogram, call the new primitive subprogram and each inherited
53
--      subprogram.
54
--
55
--      Extend the extension with a private extension in a third package
56
--      specification. Declare a new primitive subprogram for this private
57
--      extension, and override one of the three inherited subprograms.
58
--      Within the overriding subprogram, utilize type conversion to call the
59
--      parent's implementation of the same subprogram. Also within the
60
--      overriding subprogram, call the new primitive subprogram and each
61
--      inherited subprogram.
62
--
63
--      Also in the third package, declare two operations of the private
64
--      extension which utilize aggregates and equality operators to verify
65
--      the correctness of the components.
66
--
67
--      In the main program, declare objects of the two extended types.
68
--      For each object, call the overriding subprogram, and verify the
69
--      correctness of the components by using aggregates and equality
70
--      operators, or by checking the components directly, or, for the private
71
--      extension, by calling the verification operations declared in the
72
--      third package.
73
--
74
-- TEST FILES:
75
--      This test consists of the following files:
76
--
77
--         F390A00.A
78
--         C390A020.A
79
--         C390A021.A
80
--      => C390A022.AM
81
--
82
--
83
-- CHANGE HISTORY:
84
--      06 Dec 94   SAIC    ACVC 2.0
85
--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
86
--
87
--!
88
 
89
with Report;
90
 
91
with F390A00;   -- Basic alert abstraction.
92
with C390A020;  -- Extended alert abstraction.
93
with C390A021;  -- Further extended alert abstraction.
94
 
95
use  F390A00;   -- Primitive operations of Alert_Type directly visible.
96
 
97
with Ada.Calendar;
98
 
99
procedure C390A022 is
100
   use type Ada.Calendar.Time;  -- Equality/inequality ops directly visible.
101
begin
102
 
103
   Report.Test ("C390A02", "Primitive operation inheritance by type " &
104
                "extensions: all extensions declared in different " &
105
                "packages; second extension is private");
106
 
107
 
108
   -- The case for type F390A00.Alert_Type is tested in C390A01.
109
   -- That subtest is not repeated here.
110
 
111
 
112
   LOW_ALERT_SUBTEST: ---------------------------------------------------------
113
 
114
      declare
115
         Low_Alarm : C390A020.Low_Alert_Type;  -- Extension of tagged type.
116
         use C390A020; -- Primitive operations of extension directly visible.
117
      begin
118
 
119
         -- Check "=" operator availability. Aggregate with positional
120
         -- associations:
121
         if not (Low_Alarm = (Default_Time, Null_Device, 0)) then
122
            Report.Failed ("Wrong initial values for Low_Alert_Type");
123
         end if;
124
 
125
         Handle (Low_Alarm);
126
 
127
         -- Check component availability:
128
         if Low_Alarm.Arrival_Time /= Alert_Time or
129
            Low_Alarm.Display_On   /= Teletype   or
130
            Low_Alarm.Level        /= 1
131
         then
132
            Report.Failed ("Wrong values for Low_Alert_Type after Handle");
133
         end if;
134
      end Low_Alert_Subtest;
135
 
136
 
137
   -- Check intermediate display counts:
138
 
139
   if F390A00.Display_Count_For /= (Null_Device => 1,
140
                                    Teletype    => 1,
141
                                    Console     => 0,
142
                                    Big_Screen  => 0)
143
   then
144
      Report.Failed ("Wrong display counts after Low_Alert_Type");
145
   end if;
146
 
147
 
148
   MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
149
 
150
      declare
151
         Medium_Alarm : C390A021.Medium_Alert_Type; -- Priv. ext. of extension.
152
         use C390A021; -- Primitive operations of extension directly visible.
153
      begin
154
         if not C390A021.Initial_Values_Okay (Medium_Alarm) then
155
            Report.Failed ("Wrong initial values for Medium_Alert_Type");
156
         end if;
157
 
158
         Handle (Medium_Alarm);
159
 
160
         if C390A021.Bad_Final_Values (Medium_Alarm) then
161
            Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
162
         end if;
163
      end Medium_Alert_Subtest;
164
 
165
 
166
   -- Check final display counts:
167
 
168
   if F390A00.Display_Count_For /= (Null_Device => 2,
169
                                    Teletype    => 2,
170
                                    Console     => 1,
171
                                    Big_Screen  => 0)
172
   then
173
      Report.Failed ("Wrong display counts after Medium_Alert_Type");
174
   end if;
175
 
176
 
177
   Report.Result;
178
 
179
end C390A022;

powered by: WebSVN 2.1.0

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