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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CA15003.A
2
--                             Grant of Unlimited Rights
3
--
4
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
5
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
6
--     unlimited rights in the software and documentation contained herein.
7
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
8
--     this public release, the Government intends to confer upon all
9
--     recipients unlimited rights  equal to those held by the Government.
10
--     These rights include rights to use, duplicate, release or disclose the
11
--     released technical data and computer software in whole or in part, in
12
--     any manner and for any purpose whatsoever, and to have or permit others
13
--     to do so.
14
--
15
--                                    DISCLAIMER
16
--
17
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
18
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
19
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
20
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
21
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
22
--     PARTICULAR PURPOSE OF SAID MATERIAL.
23
--*
24
--
25
-- OBJECTIVE
26
--     Check the requirements of 10.1.5(4) and the modified 10.1.5(5)
27
--     from Technical Corrigendum 1. (Originally discussed as AI95-00136.)
28
--     Specifically:
29
--     Check that program unit pragma for a generic package are accepted
30
--     when given at the beginning of the package specification.
31
--     Check that a program unit pragma can be given for a generic
32
--     instantiation by placing the pragma immediately after the instantation.
33
--
34
-- TEST DESCRIPTION
35
--     This test checks the cases that are *not* forbidden by the RM,
36
--     and makes sure such legal cases actually work.
37
--
38
-- CHANGE HISTORY:
39
--      29 JUN 1999   RAD   Initial Version
40
--      08 JUL 1999   RLB   Cleaned up and added to test suite.
41
--      27 AUG 1999   RLB   Repaired errors introduced by me.
42
--
43
--!
44
 
45
with System;
46
package CA15003A is
47
    pragma Pure;
48
 
49
    type Big_Int is range -System.Max_Int .. System.Max_Int;
50
    type Big_Positive is new Big_Int range 1..Big_Int'Last;
51
end CA15003A;
52
 
53
generic
54
    type Int is new Big_Int;
55
package CA15003A.Pure is
56
    pragma Pure;
57
    function F(X: access Int) return Int;
58
end CA15003A.Pure;
59
 
60
with CA15003A.Pure;
61
package CA15003A.Pure_Instance is new CA15003A.Pure(Int => Big_Positive);
62
    pragma Pure(CA15003A.Pure_Instance);
63
 
64
package body CA15003A.Pure is
65
    function F(X: access Int) return Int is
66
    begin
67
        X.all := X.all + 1;
68
        return X.all;
69
    end F;
70
end CA15003A.Pure;
71
 
72
generic
73
package CA15003A.Pure.Preelaborate is
74
    pragma Preelaborate;
75
    One: Int := 1;
76
    function F(X: access Int) return Int;
77
end CA15003A.Pure.Preelaborate;
78
 
79
package body CA15003A.Pure.Preelaborate is
80
    function F(X: access Int) return Int is
81
    begin
82
        X.all := X.all + One;
83
        return X.all;
84
    end F;
85
end CA15003A.Pure.Preelaborate;
86
 
87
with CA15003A.Pure_Instance;
88
with CA15003A.Pure.Preelaborate;
89
package CA15003A.Pure_Preelaborate_Instance is
90
    new CA15003A.Pure_Instance.Preelaborate;
91
        pragma Preelaborate(CA15003A.Pure_Preelaborate_Instance);
92
 
93
package CA15003A.Empty_Pure is
94
    pragma Pure;
95
    pragma Elaborate_Body;
96
end CA15003A.Empty_Pure;
97
 
98
package body CA15003A.Empty_Pure is
99
end CA15003A.Empty_Pure;
100
 
101
package CA15003A.Empty_Preelaborate is
102
    pragma Preelaborate;
103
    pragma Elaborate_Body;
104
    One: Big_Int := 1;
105
end CA15003A.Empty_Preelaborate;
106
 
107
package body CA15003A.Empty_Preelaborate is
108
    function F(X: access Big_Int) return Big_Int is
109
    begin
110
        X.all := X.all + One;
111
        return X.all;
112
    end F;
113
end CA15003A.Empty_Preelaborate;
114
 
115
package CA15003A.Empty_Elaborate_Body is
116
    pragma Elaborate_Body;
117
    Three: aliased Big_Positive := 1;
118
    Two, Tres: Big_Positive'Base := 0;
119
end CA15003A.Empty_Elaborate_Body;
120
 
121
with Report; use Report; pragma Elaborate_All(Report);
122
with CA15003A.Pure_Instance;
123
with CA15003A.Pure_Preelaborate_Instance;
124
use CA15003A;
125
package body CA15003A.Empty_Elaborate_Body is
126
begin
127
    if Two /= Big_Positive'Base(Ident_Int(0)) then
128
        Failed ("Two should be zero now");
129
    end if;
130
    if Tres /= Big_Positive'Base(Ident_Int(0)) then
131
        Failed ("Tres should be zero now");
132
    end if;
133
    if Two /= Tres then
134
        Failed ("Tres should be zero now");
135
    end if;
136
    Two := Pure_Instance.F(Three'Access);
137
    Tres := Pure_Preelaborate_Instance.F(Three'Access);
138
    if Two /= Big_Positive(Ident_Int(2)) then
139
        Failed ("Two should be 2 now");
140
    end if;
141
    if Tres /= Big_Positive(Ident_Int(3)) then
142
        Failed ("Tres should be 3 now");
143
    end if;
144
end CA15003A.Empty_Elaborate_Body;
145
 
146
with Report; use Report;
147
with CA15003A.Empty_Pure;
148
with CA15003A.Empty_Preelaborate;
149
with CA15003A.Empty_Elaborate_Body; use CA15003A.Empty_Elaborate_Body;
150
use type CA15003A.Big_Positive'Base;
151
procedure CA15003 is
152
begin
153
    Test("CA15003", "Placement of Program Unit Pragmas in Generic Packages");
154
    if Two /= 2 then
155
        Failed ("Two should be 2 now");
156
    end if;
157
    if Tres /= 3 then
158
        Failed ("Tres should be 3 now");
159
    end if;
160
    Result;
161
end CA15003;

powered by: WebSVN 2.1.0

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