1-- C58005A.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 WHEN A FUNCTION IS READY TO RETURN CONTROL TO ITS INVOKER
26--    THE CONSTRAINTS ON THE RETURN VALUES ARE CHECKED, AND THAT
27--     CONSTRAINT ERROR  IS THEN RAISED IF AND ONLY IF THE CONSTRAINTS
28--    ARE NOT SATISFIED.
29
30-- THIS TEST CHECKS THAT THE EXCEPTION IS RAISED UNDER THE APPROPRIATE
31--    CONDITIONS; IT ALSO CHECKS THE IDENTITY OF THE EXCEPTION.  THE
32--    PRECISE MOMENT AND PLACE THE EXCEPTION IS RAISED IS TESTED
33--    ELSEWHERE.
34
35
36-- RM 05/14/81
37-- SPS 10/26/82
38
39WITH REPORT;
40PROCEDURE  C58005A  IS
41
42     USE  REPORT ;
43
44     INTVAR  :  INTEGER ;
45
46BEGIN
47
48     TEST( "C58005A" , "CHECK THAT EXCEPTIONS ARE RAISED BY A RETURN"  &
49                       " STATEMENT IF AND ONLY IF THE CONSTRAINTS ARE" &
50                       " VIOLATED" );
51
52
53     DECLARE
54          SUBTYPE I1 IS INTEGER RANGE -10..90;
55          SUBTYPE I2 IS INTEGER RANGE 1..10;
56          FUNCTION  FN1( X : I1 )
57                    RETURN  I2  IS
58          BEGIN
59               RETURN  0 ;
60          END  FN1 ;
61
62          FUNCTION  FN2( X : I1 )
63                    RETURN  I2  IS
64          BEGIN
65               RETURN  X + IDENT_INT(0) ;
66          END  FN2 ;
67
68          FUNCTION  FN3( X : I1  )
69                    RETURN  I2  IS
70               HUNDRED : INTEGER RANGE -100..100 := IDENT_INT(100) ;
71          BEGIN
72               RETURN  HUNDRED - 90 ;
73          END  FN3 ;
74
75     BEGIN
76
77          INTVAR := 0 ;
78
79          BEGIN
80               INTVAR := FN1( 0 ) + INTVAR ;  -- EXCEPTION.
81               FAILED( "EXCEPTION NOT RAISED  -  1" );
82          EXCEPTION
83               WHEN CONSTRAINT_ERROR => INTVAR := INTVAR + 10 ;
84               WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  1" ) ;
85          END ;
86
87          BEGIN
88               INTVAR := FN2( 1 ) + INTVAR ; -- 10+1=11 -- NO EXCEPTION.
89               INTVAR := INTVAR + 100 ;   -- 11+100=111
90          EXCEPTION
91               WHEN OTHERS => FAILED( "EXCEPTION RAISED  -  2" ) ;
92          END ;
93
94          BEGIN
95               INTVAR := FN2(11 ) + INTVAR ;  -- EXCEPTION.
96               FAILED( "EXCEPTION NOT RAISED  -  3" );
97          EXCEPTION
98               WHEN CONSTRAINT_ERROR => INTVAR := INTVAR + 10 ; -- 121
99               WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  3" ) ;
100          END ;
101
102          BEGIN
103               INTVAR := FN3( 0 ) + INTVAR ;--121+10=131 --NO EXCEPTION.
104               INTVAR := INTVAR + 1000 ;-- 131+1000=1131
105          EXCEPTION
106               WHEN OTHERS => FAILED( "EXCEPTION RAISED  -  4" ) ;
107          END ;
108
109
110     END ;
111
112
113     IF  INTVAR /= 1131  THEN
114          FAILED("WRONG FLOW OF CONTROL" );
115     END IF;
116
117
118     RESULT ;
119
120
121END C58005A;
122