1-- C58005B.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 GENERIC FUNCTION IS READY TO RETURN CONTROL TO ITS
26--    INVOKER 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-- SPS 3/10/83
36-- JBG 9/13/83
37-- AH  8/29/86  ADDED CALLS TO "FAILED" AFTER "IF" STATEMENTS.
38
39WITH REPORT;
40PROCEDURE  C58005B  IS
41
42     USE  REPORT;
43
44BEGIN
45
46     TEST( "C58005B" , "CHECK THAT EXCEPTIONS ARE RAISED BY A RETURN"  &
47                       " STATEMENT IF AND ONLY IF THE CONSTRAINTS ARE" &
48                       " VIOLATED" );
49
50
51     DECLARE
52          SUBTYPE I1 IS INTEGER RANGE -10..90;
53          SUBTYPE I2 IS INTEGER RANGE 1..10;
54
55          GENERIC
56          FUNCTION FN1 ( X : I1 ) RETURN I2;
57
58          FUNCTION  FN1( X : I1 )
59                    RETURN  I2  IS
60          BEGIN
61               RETURN X;
62          END  FN1;
63
64          FUNCTION F1 IS NEW FN1;
65
66     BEGIN
67
68          BEGIN
69               IF F1(IDENT_INT(0)) IN I2 THEN
70                    FAILED( "EXCEPTION NOT RAISED  -  1A" );
71               ELSE
72                    FAILED( "EXCEPTION NOT RAISED  -  1B" );
73               END IF;
74          EXCEPTION
75               WHEN CONSTRAINT_ERROR => NULL;
76               WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  1" );
77          END;
78
79          BEGIN
80               IF F1(IDENT_INT(11)) IN I2 THEN
81                    FAILED( "EXCEPTION NOT RAISED  -  2A" );
82               ELSE
83                    FAILED( "EXCEPTION NOT RAISED  -  2B" );
84               END IF;
85          EXCEPTION
86               WHEN CONSTRAINT_ERROR => NULL;
87               WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  2" );
88          END;
89
90     END;
91
92     RESULT;
93
94END C58005B;
95