OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca5006a.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CA5006A.ADA
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
-- CHECK THAT A PROGRAM IS NOT REJECTED JUST BECAUSE THERE IS NO WAY TO
26
-- ELABORATE SECONDARY UNITS SO PROGRAM_ERROR WILL BE AVOIDED.
27
 
28
-- R.WILLIAMS 9/22/86
29
 
30
-----------------------------------------------------------------------
31
 
32
PACKAGE CA5006A0 IS
33
   FUNCTION P_E_RAISED RETURN BOOLEAN;
34
   PROCEDURE SHOW_PE_RAISED;
35
END CA5006A0;
36
 
37
-----------------------------------------------------------------------
38
 
39
WITH REPORT; USE REPORT;
40
PRAGMA ELABORATE (REPORT);
41
PACKAGE BODY CA5006A0 IS
42
   RAISED : BOOLEAN := FALSE;
43
 
44
   FUNCTION P_E_RAISED RETURN BOOLEAN IS
45
   BEGIN
46
      RETURN RAISED;
47
   END P_E_RAISED;
48
 
49
   PROCEDURE SHOW_PE_RAISED IS
50
   BEGIN
51
      RAISED := TRUE;
52
   END SHOW_PE_RAISED;
53
 
54
BEGIN
55
     TEST ( "CA5006A", "CHECK THAT A PROGRAM IS NOT REJECTED JUST " &
56
                       "BECAUSE THERE IS NO WAY TO ELABORATE " &
57
                       "SECONDARY UNITS SO PROGRAM_ERROR WILL BE " &
58
                       "AVOIDED" );
59
 
60
 
61
END CA5006A0;
62
 
63
-----------------------------------------------------------------------
64
 
65
PACKAGE CA5006A1 IS
66
  FUNCTION F RETURN INTEGER;
67
END CA5006A1;
68
 
69
-----------------------------------------------------------------------
70
 
71
PACKAGE CA5006A2 IS
72
  FUNCTION G RETURN INTEGER;
73
END CA5006A2;
74
 
75
-----------------------------------------------------------------------
76
 
77
WITH REPORT; USE REPORT;
78
WITH CA5006A0; USE CA5006A0;
79
WITH CA5006A2; USE CA5006A2;
80
PRAGMA ELABORATE(CA5006A0);
81
 
82
PACKAGE BODY CA5006A1 IS
83
   X : INTEGER;
84
 
85
   FUNCTION F RETURN INTEGER IS
86
   BEGIN
87
      RETURN IDENT_INT(0);
88
   END F;
89
 
90
BEGIN
91
   X := G;
92
   IF NOT P_E_RAISED THEN
93
      FAILED ( "G CALLED" );
94
   END IF;
95
EXCEPTION
96
   WHEN PROGRAM_ERROR =>
97
      COMMENT ( "PROGRAM_ERROR RAISED IN CA5006A1" );
98
      SHOW_PE_RAISED;
99
   WHEN OTHERS =>
100
      FAILED ( "OTHER ERROR RAISED IN CA5006A1" );
101
END CA5006A1;
102
 
103
-----------------------------------------------------------------------
104
 
105
WITH REPORT; USE REPORT;
106
WITH CA5006A0; USE CA5006A0;
107
WITH CA5006A1; USE CA5006A1;
108
PRAGMA ELABORATE(CA5006A0);
109
 
110
PACKAGE BODY CA5006A2 IS
111
   X : INTEGER;
112
 
113
   FUNCTION G RETURN INTEGER IS
114
   BEGIN
115
      RETURN IDENT_INT(1);
116
   END G;
117
 
118
BEGIN
119
   X := F;
120
   IF NOT P_E_RAISED THEN
121
      FAILED ( "F CALLED" );
122
   END IF;
123
EXCEPTION
124
   WHEN PROGRAM_ERROR =>
125
      COMMENT ( "PROGRAM_ERROR RAISED IN CA5006A2" );
126
      SHOW_PE_RAISED;
127
   WHEN OTHERS =>
128
      FAILED ( "OTHER ERROR RAISED IN CA5006A2" );
129
END CA5006A2;
130
 
131
-----------------------------------------------------------------------
132
 
133
WITH REPORT; USE REPORT;
134
WITH CA5006A0; USE CA5006A0;
135
WITH CA5006A1;
136
WITH CA5006A2;
137
 
138
PROCEDURE CA5006A IS
139
BEGIN
140
   IF NOT P_E_RAISED THEN
141
      FAILED ( "PROGRAM_ERROR NEVER RAISED" );
142
   END IF;
143
 
144
   RESULT;
145
END CA5006A;

powered by: WebSVN 2.1.0

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