1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
-- CC51A01.A
--
-- Grant of Unlimited Rights
--
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
-- unlimited rights in the software and documentation contained herein.
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
-- this public release, the Government intends to confer upon all
-- recipients unlimited rights equal to those held by the Government.
-- These rights include rights to use, duplicate, release or disclose the
-- released technical data and computer software in whole or in part, in
-- any manner and for any purpose whatsoever, and to have or permit others
-- to do so.
--
-- DISCLAIMER
--
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
-- PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
-- Check that, in an instance, each implicit declaration of a user-defined
-- subprogram of a formal derived record type declares a view of the
-- corresponding primitive subprogram of the ancestor, even if the
-- primitive subprogram has been overridden for the actual type.
--
-- TEST DESCRIPTION:
-- Declare a "fraction" type abstraction in a package (foundation code).
-- Declare a "fraction" I/O routine in a generic package with a formal
-- derived type whose ancestor type is the fraction type declared in
-- the first package. Within the I/O routine, call other operations of
-- ancestor type. Derive from the root fraction type in another package
-- and override one of the operations called in the generic I/O routine.
-- Derive from the derivative of the root fraction type. Instantiate
-- the generic package for each of the three types and call the I/O
-- routine.
--
-- TEST FILES:
-- The following files comprise this test:
--
-- FC51A00.A
-- CC51A01.A
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
with FC51A00; -- Fraction type abstraction.
generic -- Fraction I/O support.
type Fraction is new FC51A00.Fraction_Type; -- Formal derived type of a
package CC51A01_0 is -- (private) record type.
-- Simulate writing a fraction to standard output. In a real application,
-- this subprogram might be a procedure which uses Text_IO routines. For
-- the purposes of the test, the "output" is returned to the caller as a
-- string.
function Put (Item : in Fraction) return String;
-- ... Other I/O operations for fractions.
end CC51A01_0;
--==================================================================--
package body CC51A01_0 is
function Put (Item : in Fraction) return String is
Num : constant String := -- Fraction's primitive subprograms
Integer'Image (Numerator (Item)); -- are inherited from its parent
Den : constant String := -- (FC51A00.Fraction_Type) and NOT
Integer'Image (Denominator (Item)); -- from the actual type.
begin
return (Num & '/' & Den);
end Put;
end CC51A01_0;
--==================================================================--
with FC51A00; -- Fraction type abstraction.
package CC51A01_1 is
-- Derive directly from the root type of the class and override one of the
-- primitive subprograms.
type Pos_Fraction is new FC51A00.Fraction_Type; -- Derived directly from
-- root type of class.
-- Inherits "/" from root type.
-- Inherits "-" from root type.
-- Inherits Numerator from root type.
-- Inherits Denominator from root type.
-- Return absolute value of numerator as integer.
function Numerator (Frac : Pos_Fraction) -- Overrides parent's
return Integer; -- operation.
end CC51A01_1;
--==================================================================--
package body CC51A01_1 is
-- This body should never be called.
--
-- The test sends the function Numerator a fraction with a negative
-- numerator, and expects this negative numerator to be returned. This
-- version of the function returns the absolute value of the numerator.
-- Thus, a call to this version is detectable by examining the sign
-- of the return value.
function Numerator (Frac : Pos_Fraction) return Integer is
Converted_Frac : FC51A00.Fraction_Type := FC51A00.Fraction_Type (Frac);
Orig_Numerator : Integer := FC51A00.Numerator (Converted_Frac);
begin
return abs (Orig_Numerator);
end Numerator;
end CC51A01_1;
--==================================================================--
with FC51A00; -- Fraction type abstraction.
with CC51A01_0; -- Fraction I/O support.
with CC51A01_1; -- Positive fraction type abstraction.
with Report;
procedure CC51A01 is
type Distance is new CC51A01_1.Pos_Fraction; -- Derived indirectly from
-- root type of class.
-- Inherits "/" indirectly from root type.
-- Inherits "-" indirectly from root type.
-- Inherits Numerator directly from parent type.
-- Inherits Denominator indirectly from root type.
use FC51A00, CC51A01_1; -- All primitive subprograms
-- directly visible.
package Fraction_IO is new CC51A01_0 (Fraction_Type);
package Pos_Fraction_IO is new CC51A01_0 (Pos_Fraction);
package Distance_IO is new CC51A01_0 (Distance);
-- For each of the instances above, the subprogram "Put" should produce
-- the same result. That is, the primitive subprograms called by Put
-- should in all cases be those of the type Fraction_Type, which is the
-- ancestor type for the formal derived type in the generic unit. In
-- particular, for Pos_Fraction_IO and Distance_IO, the versions of
-- Numerator called should NOT be those of the actual types, which override
-- Fraction_Type's version.
TC_Expected_Result : constant String := "-3/ 16";
TC_Root_Type_Of_Class : Fraction_Type := -3/16;
TC_Direct_Derivative : Pos_Fraction := -3/16;
TC_Indirect_Derivative : Distance := -3/16;
begin
Report.Test ("CC51A01", "Check that, in an instance, each implicit " &
"declaration of a user-defined subprogram of a formal " &
"derived record type declares a view of the corresponding " &
"primitive subprogram of the ancestor, even if the " &
"primitive subprogram has been overridden for the actual " &
"type");
if (Fraction_IO.Put (TC_Root_Type_Of_Class) /= TC_Expected_Result) then
Report.Failed ("Wrong result for root type");
end if;
if (Pos_Fraction_IO.Put (TC_Direct_Derivative) /= TC_Expected_Result) then
Report.Failed ("Wrong result for direct derivative");
end if;
if (Distance_IO.Put (TC_Indirect_Derivative) /= TC_Expected_Result) then
Report.Failed ("Wrong result for INdirect derivative");
end if;
Report.Result;
end CC51A01;
|
