1-- C95086A.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 CONSTRAINT_ERROR IS NOT RAISED AT THE TIME OF CALL WHEN
26-- THE VALUE OF AN ACTUAL OUT SCALAR PARAMETER DOES NOT SATISFY THE
27-- RANGE CONSTRAINTS OF THE FORMAL PARAMETER.
28
29-- GLH 7/16/85
30-- JRK 8/23/85
31
32WITH REPORT; USE REPORT;
33PROCEDURE C95086A IS
34
35     SUBTYPE SUBINT1 IS INTEGER RANGE -10..10;
36     SUBTYPE SUBINT2 IS INTEGER RANGE -20..20;
37
38     I10  : SUBINT1 := 10;
39     I20  : SUBINT2 := 20;
40
41     TASK T1 IS
42          ENTRY E1 (I : OUT SUBINT1);
43     END T1;
44
45     TASK BODY T1 IS
46     BEGIN
47          LOOP
48               BEGIN
49                    SELECT
50                         ACCEPT E1 (I : OUT SUBINT1) DO
51                              I := SUBINT1'FIRST;
52                         END E1;
53                    OR
54                         TERMINATE;
55                    END SELECT;
56               EXCEPTION
57                    WHEN OTHERS =>
58                         FAILED ("EXCEPTION RAISED IN ACCEPT E1");
59               END;
60          END LOOP;
61     END T1;
62
63BEGIN
64
65     TEST ("C95086A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
66                      "AT THE TIME OF CALL WHEN THE VALUE OF AN " &
67                      "ACTUAL OUT SCALAR PARAMETER DOES NOT " &
68                      "SATISFY THE RANGE CONSTRAINTS OF THE FORMAL " &
69                      "PARAMETER");
70
71     BEGIN
72          T1.E1 (SUBINT1(I20));
73          IF I20 /= IDENT_INT (-10) THEN
74               FAILED ("OUT PARAM DID NOT GET CORRECT VALUE - 1");
75          END IF;
76     EXCEPTION
77          WHEN OTHERS =>
78               FAILED ("EXCEPTION RAISED ON CALL TO E1 - 1");
79     END;
80
81     BEGIN
82          I20 := IDENT_INT (20);
83          T1.E1 (I20);
84          IF I20 /= IDENT_INT (-10) THEN
85               FAILED ("OUT PARAM DID NOT GET CORRECT VALUE - 2");
86          END IF;
87     EXCEPTION
88          WHEN OTHERS =>
89               FAILED ("EXCEPTION RAISED ON CALL TO E1 - 2");
90     END;
91
92     RESULT;
93
94END C95086A;
95