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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C393B14.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 a private child package
28
--      from an abstract type defined in a library package.
29
--
30
-- TEST DESCRIPTION:
31
--      Add a private child package to Alert_Foundation.  Using Private_Alert
32
--      as parent type, declare an extended type adding a new record component.
33
--      Override procedure Handle.  Declare an object of the new type in the
34
--      child specification. Use type definitions from the private part of the
35
--      parent in the body of the child.
36
--
37
-- TEST FILES:
38
--      This test depends on the following foundation code:
39
--
40
--         F393B00.A  Package Alert_Foundation
41
--
42
--
43
-- CHANGE HISTORY:
44
--      06 Dec 94   SAIC    ACVC 2.0
45
--
46
--!
47
 
48
private package F393B00.C393B14_0 is
49
             -- Alert_Foundation.Private_Child
50
 
51
  type Implementation_Specific_Alert_Type is new Private_Alert with record
52
    New_Private_Field : Implementation_Detail
53
                        := Implementation_Detail'Last;
54
  end record;
55
 
56
  procedure Handle (PA : in out Implementation_Specific_Alert_Type);
57
                             -- overrides abstract Handle, as required
58
  PA : Implementation_Specific_Alert_Type;
59
 
60
end F393B00.C393B14_0;
61
 -- Alert_Foundation.Private_Child
62
 
63
--=======================================================================--
64
 
65
package body F393B00.C393B14_0 is
66
                  -- Alert_Foundation.Private_Child
67
 
68
  procedure Handle (PA : in out Implementation_Specific_Alert_Type) is
69
    begin
70
      PA.Private_Field := 1;
71
      PA.New_Private_Field := PA.Private_Field + 1;
72
    end;
73
 
74
end F393B00.C393B14_0;
75
 -- Alert_Foundation.Private_Child
76
 
77
--=======================================================================--
78
 
79
package F393B00.C393B14_1 is
80
     -- Alert_Foundation.Public_Child
81
 
82
  type Timing is (Before, After);
83
  procedure Init;
84
  procedure Modify;
85
  function Check_Before return Boolean;
86
  function Check_After  return Boolean;
87
 
88
end F393B00.C393B14_1;
89
 -- Alert_Foundation.Public_Child
90
 
91
--=======================================================================--
92
 
93
with F393B00.C393B14_0;               -- private sibling is visible in the
94
  -- Alert_Foundation.Private_Child   -- body of a public sibling
95
package body F393B00.C393B14_1 is
96
     -- Alert_Foundation.Public_Child
97
  package Priv renames F393B00.C393B14_0;
98
 
99
  procedure Init is
100
    begin
101
      Priv.PA.Private_Field     := 5;
102
      Priv.PA.New_Private_Field := 10;
103
    end Init;
104
 
105
  procedure Modify is
106
    begin
107
      Priv.Handle (Priv.PA);
108
    end Modify;
109
 
110
  function Check_Before return Boolean is
111
    begin
112
      return ((Priv.PA.Private_Field = 5)
113
               and (Priv.PA.New_Private_Field =10));
114
    end Check_Before;
115
 
116
  function Check_After return Boolean is
117
    begin
118
      return ((Priv.PA.Private_Field = 1)
119
               and (Priv.PA.New_Private_Field = 2));
120
    end Check_After;
121
 
122
end F393B00.C393B14_1;
123
 -- Alert_Foundation.Public_Child
124
 
125
--=======================================================================--
126
 
127
with Report;
128
with F393B00.C393B14_1;
129
procedure C393B14 is
130
 -- Alert_Foundation.Public_Child;
131
 
132
begin
133
  Report.Test ("C393B14", "Check that an extended type can be derived " &
134
                          "from an abstract type");
135
 
136
  F393B00.C393B14_1.Init;
137
  if not F393B00.C393B14_1.Check_Before then
138
    Report.Failed ("Wrong initialization");
139
  end if;
140
 
141
  F393B00.C393B14_1.Modify;
142
  if not F393B00.C393B14_1.Check_After then
143
    Report.Failed ("Wrong results from Handle");
144
  end if;
145
 
146
  Report.Result;
147
end C393B14;

powered by: WebSVN 2.1.0

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