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/] [c393b12.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C393B12.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
-- TEST OBJECTIVE:
27
--      Check that an extended type can be derived in the specification of a
28
--      generic package when the parent is an abstract type in a library
29
--      package.
30
--
31
-- TEST DESCRIPTION:
32
--      Extend an abstract type in the visible part of a generic package.
33
--      Make all of the procedures which override abstract procedures
34
--      available as part of the generic interface.  Instantiate the generic.
35
--
36
-- TEST FILES:
37
--      This test depends on the following foundation code:
38
--
39
--         F393B00.A  Package Alert_Foundation
40
--
41
--
42
-- CHANGE HISTORY:
43
--      06 Dec 94   SAIC    ACVC 2.0
44
--      14 Oct 95   SAIC    Update and repair for ACVC 2.0.1
45
--      27 Feb 97   PWB.CTA Add pragma Elaborate for C393B12_0.
46
--!
47
 
48
----------------------------------------------------------------- C393B12_0
49
 
50
with F393B00;
51
  -- Alert_Foundation
52
generic
53
  type Generic_Status_Enum is (<>);
54
 
55
package C393B12_0 is
56
     -- Alert_Functions
57
 
58
  type Generic_Alert_Type is new F393B00.Alert with record
59
    Status : Generic_Status_Enum := Generic_Status_Enum'First;
60
  end record;
61
                                     -- extension of an abstract type
62
 
63
  procedure Handle (GA : in out Generic_Alert_Type);
64
                                     -- override of abstract procedure
65
 
66
  function Query_Status (GA : Generic_Alert_Type)
67
    return Generic_Status_Enum;      -- new primitive operation for
68
                                     -- Generic_Alert_Type
69
end C393B12_0;
70
 -- Alert_Functions
71
 
72
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
73
 
74
package body C393B12_0 is
75
          -- Alert_Functions
76
 
77
  procedure Handle (GA : in out Generic_Alert_Type) is
78
    begin
79
      GA.Status := Generic_Status_Enum'Last;
80
    end Handle;
81
 
82
  function Query_Status (GA : Generic_Alert_Type)
83
    return Generic_Status_Enum is
84
    begin
85
      return GA.Status;
86
    end Query_Status;
87
 
88
end C393B12_0;
89
 
90
----------------------------------------------------------------- C393B12_1
91
 
92
package C393B12_1 is
93
  type Status is (Low, Medium, High);
94
end C393B12_1;
95
 
96
------------------------------------------------------- C393B12_1.C393B12_2
97
 
98
with C393B12_0;
99
pragma Elaborate (C393B12_0);
100
package C393B12_1.C393B12_2 is new C393B12_0
101
                        -- Alert_Functions
102
                 (Generic_Status_Enum => Status);
103
 
104
------------------------------------------------------------------- C393B12
105
 
106
with C393B12_1.C393B12_2;
107
with Report;
108
procedure C393B12 is
109
 
110
  use type C393B12_1.Status;
111
 
112
  package Alt_Alert renames C393B12_1.C393B12_2;
113
 
114
  GA : Alt_Alert.Generic_Alert_Type;
115
 
116
begin
117
  Report.Test ("C393B12",  "Check that an extended type can be derived " &
118
                           "from an abstract type");
119
 
120
  if Alt_Alert.Query_Status (GA) /= C393B12_1.Low then
121
    Report.Failed ("Wrong initialization");
122
  end if;
123
 
124
  Alt_Alert.Handle (GA);
125
  if Alt_Alert.Query_Status (GA) /= C393B12_1.High then
126
    Report.Failed ("Wrong results from Handle");
127
  end if;
128
 
129
  Report.Result;
130
 
131
end C393B12;

powered by: WebSVN 2.1.0

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