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/] [c3900063.am] - Blame information for rev 309

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C3900063.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 private tagged type declared in a package specification
28
--      may be extended with a private extension in a different package
29
--      specification, and that this private extension may in turn be extended
30
--      by a record 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 type conversion is defined from a type extension to its
38
--      parent, and that this parent itself may be a type extension.
39
--
40
-- TEST DESCRIPTION:
41
--      Declare a root tagged private type and two associated primitive
42
--      subprograms in a package specification. Declare operations to verify
43
--      the correctness of the components. Declare operations which return
44
--      values of the type's private components, and which will be inherited
45
--      by later derivatives.
46
--
47
--      Extend the root type with a private extension in a second 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. Declare operations of the private extension which
54
--      override the verification operations of its parent. Declare
55
--      operations which return values of the extension's private components,
56
--      and which will be inherited by later derivatives.
57
--
58
--      Extend the extension with a record extension in a third package
59
--      specification. Declare a new primitive subprogram for this record
60
--      extension, and override one of the three inherited subprograms.
61
--      Within the overriding subprogram, utilize type conversion to call the
62
--      parent's implementation of the same subprogram. Also within the
63
--      overriding subprogram, call the new primitive subprogram and each
64
--      inherited subprogram. Declare operations of the record extension
65
--      which override the verification operations of its parent.
66
--
67
--      In the main program, declare objects of the root tagged type and
68
--      the two type extensions. For each object, call the overriding
69
--      subprogram, and verify the correctness of the components by calling
70
--      the verification operations.
71
--
72
-- TEST FILES:
73
--      This test consists of the following files:
74
--
75
--         C3900060.A
76
--         C3900061.A
77
--         C3900062.A
78
--      => C3900063.AM
79
--
80
--
81
-- CHANGE HISTORY:
82
--      06 Dec 94   SAIC    ACVC 2.0
83
--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
84
--
85
--!
86
 
87
with Report;
88
 
89
with C3900060; -- Basic alert abstraction.
90
with C3900062; -- Further extended alert abstraction.
91
 
92
use  C3900060; -- Primitive operations of Alert_Type directly visible.
93
 
94
procedure C3900063 is
95
begin
96
 
97
   Report.Test ("C390006", "Primitive operation inheritance by type " &
98
                "extensions: all extensions declared in different " &
99
                "packages; root type and 1st extension are private, " &
100
                "2nd extension is record extension");
101
 
102
 
103
   -- The cases for type C3900060.Alert_Type and C3900061.Low_Alert_Type
104
   -- are tested in C390005. Those subtests are not repeated here.
105
 
106
 
107
   MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
108
 
109
      declare
110
         Medium_Alarm : C3900062.Medium_Alert_Type; -- Rec. ext. of extension.
111
         use C3900062; -- Primitive operations of extension directly visible.
112
      begin
113
         if not Initial_Values_Okay (Medium_Alarm) then
114
            Report.Failed ("Wrong initial values for Medium_Alert_Type");
115
         end if;
116
 
117
         Handle (Medium_Alarm);
118
 
119
         if Bad_Final_Values (Medium_Alarm) then
120
            Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
121
         end if;
122
      end Medium_Alert_Subtest;
123
 
124
 
125
   -- Check final display counts:
126
 
127
   if C3900060.Display_Count_For /= (Null_Device => 1,
128
                                     Teletype    => 1,
129
                                     Console     => 1,
130
                                     Big_Screen  => 0)
131
   then
132
      Report.Failed ("Wrong display counts after Medium_Alert_Type");
133
   end if;
134
 
135
 
136
   Report.Result;
137
 
138
end C3900063;

powered by: WebSVN 2.1.0

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