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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C393007.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 from an abstract type,
28
--      where the abstract type is defined in a package, and the type derived
29
--      from it is defined in a distinct library package.
30
--
31
-- TEST DESCRIPTION:
32
--      Declare an private (abstract) type; declare two primitive operations
33
--      of the type that are explicitly abstract.
34
--      Derive an extended type from the (private) abstract type, overriding
35
--      both of the primitive operations.
36
--      This test also checks to see that name overloading between abstract
37
--      and non-abstract functions is resolved correctly.
38
--
39
--
40
-- CHANGE HISTORY:
41
--      06 Dec 94   SAIC    ACVC 2.0
42
--
43
--!
44
 
45
   package C393007_0 is
46
        -- Alert_System
47
 
48
     type DT_Type is new Integer;
49
 
50
     type Alert_Type is abstract tagged record
51
        Time_Of_Arrival : DT_Type;
52
     end record;
53
 
54
     type Log_File_Type is range 0 .. 100;
55
 
56
     Procedure Handle (A : in out Alert_type) is abstract;
57
 
58
     procedure Log    (A : Alert_Type;
59
                       L : in out Log_File_Type) is abstract;
60
 
61
     procedure Set_Time (A : in out Alert_Type);
62
 
63
     function Correct_Time_Stamp (A : Alert_Type) return Boolean;
64
 
65
     Day_Time : DT_Type := 100;
66
 
67
   end C393007_0;
68
    -- Alert_System;
69
 
70
 --=======================================================================--
71
 
72
   package body C393007_0 is
73
             -- Alert_System
74
 
75
     function Time_Stamp return DT_Type is
76
       begin
77
         Day_Time := Day_Time + 1;
78
         return Day_Time;
79
       end Time_Stamp;
80
 
81
     procedure Set_Time (A : in out Alert_Type) is
82
       begin
83
         A.Time_Of_Arrival := Time_Stamp;
84
       end Set_time;
85
 
86
     function Correct_Time_Stamp ( A : Alert_Type) return Boolean is
87
       begin
88
         return (A.Time_Of_Arrival = Day_Time);
89
       end Correct_Time_Stamp;
90
 
91
   end C393007_0;
92
    -- Alert_System;
93
 
94
 --=======================================================================--
95
 
96
 with Report;
97
 with C393007_0;
98
   -- Alert_system;
99
 
100
 package C393007_1 is
101
 
102
   type Normal_Alert_Type is
103
     new C393007_0.Alert_Type
104
     with null record;
105
 
106
   Log_File: C393007_0.Log_File_Type := C393007_0.Log_File_Type'First;
107
 
108
   procedure Handle (A : in out Normal_Alert_Type);  -- Override is required
109
 
110
   procedure Log    (A : Normal_Alert_Type;          -- Override is required
111
                     L : in out C393007_0.Log_File_Type);
112
 end C393007_1;
113
 
114
 package body C393007_1 is
115
   use type C393007_0.Log_File_Type;
116
 
117
   procedure Handle (A : in out Normal_Alert_Type) is
118
     begin
119
       Set_Time (A);
120
       Log (A, Log_File);
121
     end Handle;
122
 
123
   procedure Log    (A : Normal_Alert_Type;
124
                     L : in out C393007_0.Log_File_Type) is
125
      begin
126
        L := C393007_0."+"(L, 1);
127
      end Log;
128
 
129
 end C393007_1;
130
 
131
 with Report;
132
 with C393007_0;
133
 with C393007_1;
134
   -- Alert_system;
135
 
136
 procedure C393007 is
137
   use C393007_0;
138
   use C393007_1;
139
 
140
   Alert_One : C393007_1.Normal_Alert_Type;
141
 
142
 begin
143
   Report.Test ("C393007", "Check that an extended type can be derived " &
144
                           "from an abstract type");
145
 
146
   Handle (Alert_One);
147
   if not Correct_Time_Stamp (Alert_One) then
148
     Report.Failed ("Wrong results from procedure Handle");
149
   end if;
150
 
151
   if Log_File /=1 then
152
     Report.Failed ("Wrong results");
153
   end if;
154
 
155
   Report.Result;
156
 
157
 end C393007;

powered by: WebSVN 2.1.0

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