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/] [c5/] [c58006b.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn 
-- C58006B.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 IF THE EVALUATION OF A RETURN STATEMENT'S EXPRESSION
26 
-- RAISES AN EXCEPTION, THE EXCEPTION CAN BE HANDLED WITHIN THE BODY OF
27 
-- THE FUNCTION.
28 
 
29 
-- CHECKS GENERIC FUNCTIONS.
30 
 
31 
-- SPS 3/8/83
32 
-- JBG 9/13/83
33 
 
34 
WITH REPORT;
35 
PROCEDURE  C58006B  IS
36 
 
37 
     USE  REPORT;
38 
 
39 
BEGIN
40 
 
41 
     TEST( "C58006B" , "CHECK THAT EXCEPTION RAISED BY A RETURN" &
42 
                       " STATEMENT CAN BE HANDLED LOCALLY" );
43 
 
44 
 
45 
     DECLARE
46 
          SUBTYPE I1 IS INTEGER RANGE -10..90;
47 
          SUBTYPE I2 IS INTEGER RANGE 1..10;
48 
 
49 
          GENERIC
50 
          FUNCTION FN1 (X : I1) RETURN I2;
51 
 
52 
          GENERIC
53 
          FUNCTION FN2 (X : I1) RETURN I2;
54 
 
55 
          GENERIC
56 
          FUNCTION FN3 (X : I1) RETURN I2;
57 
 
58 
          FUNCTION  FN1( X : I1 )
59 
                    RETURN  I2  IS
60 
          BEGIN
61 
               RETURN  0;
62 
          EXCEPTION
63 
               WHEN CONSTRAINT_ERROR =>
64 
                    COMMENT ("EXCEPTION RAISED - F1");
65 
                    RETURN 1;
66 
               WHEN OTHERS =>
67 
                    FAILED ("WRONG EXCEPTION RAISED - FN1");
68 
          END  FN1;
69 
 
70 
          FUNCTION  FN2( X : I1 )
71 
                    RETURN  I2  IS
72 
          BEGIN
73 
               RETURN  X + IDENT_INT(0);
74 
          EXCEPTION
75 
               WHEN CONSTRAINT_ERROR =>
76 
                    COMMENT ("EXCEPTION RAISED - F2");
77 
                    RETURN 1;
78 
               WHEN OTHERS =>
79 
                    FAILED ("WRONG EXCEPTION RAISED - FN2");
80 
          END  FN2;
81 
 
82 
          FUNCTION  FN3( X : I1 )
83 
                    RETURN  I2  IS
84 
               HUNDRED : INTEGER RANGE -100..100 := IDENT_INT(100);
85 
          BEGIN
86 
               RETURN  HUNDRED;
87 
          EXCEPTION
88 
               WHEN CONSTRAINT_ERROR =>
89 
                    COMMENT ("EXCEPTION RAISED - F3");
90 
                    RETURN 1;
91 
               WHEN OTHERS =>
92 
                    FAILED ("WRONG EXCEPTION RAISED - FN3");
93 
          END  FN3;
94 
 
95 
          FUNCTION F1 IS NEW FN1;
96 
          FUNCTION F2 IS NEW FN2;
97 
          FUNCTION F3 IS NEW FN3;
98 
 
99 
     BEGIN
100 
 
101 
          BEGIN
102 
               IF F1( 0 ) /= IDENT_INT(1) THEN
103 
                    FAILED ("NO EXCEPTION RAISED - F1( 0 )");
104 
               END IF;
105 
          EXCEPTION
106 
               WHEN OTHERS =>
107 
                    FAILED ("EXCEPTION PROPAGATED - F1( 0 )");
108 
          END;
109 
 
110 
          BEGIN
111 
               IF F2( 0 ) /= IDENT_INT(1) THEN
112 
                    FAILED ("NO EXCEPTION RAISED - F2( 0 )");
113 
               END IF;
114 
          EXCEPTION
115 
               WHEN OTHERS =>
116 
                    FAILED ("EXCEPTION PROPAGATED - F2( 0 )");
117 
          END;
118 
 
119 
          BEGIN
120 
               IF F2(11 ) /= IDENT_INT(1) THEN
121 
                    FAILED ("NO EXCEPTION RAISED - F2(11 )");
122 
               END IF;
123 
          EXCEPTION
124 
               WHEN OTHERS =>
125 
                    FAILED ("EXCEPTION PROPAGATED - F2(11 )");
126 
          END;
127 
 
128 
          BEGIN
129 
               IF F3( 0 ) /= IDENT_INT(1) THEN
130 
                    FAILED ("NO EXCEPTION RAISED - F3( 0 )");
131 
               END IF;
132 
          EXCEPTION
133 
               WHEN OTHERS =>
134 
                    FAILED ("EXCEPTION PROPAGATED - F3( 0 )");
135 
          END;
136 
 
137 
     END;
138 
 
139 
     RESULT;
140 
 
141 
END C58006B;

powered by: WebSVN 2.1.0

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