1-- C54A13C.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-- OBJECTIVE:
26--     CHECK THAT IF A CASE EXPRESSION IS A QUALIFIED EXPRESSION, A
27--     TYPE CONVERSION, OR ONE OF THESE IN PARENTHESES, AND ITS
28--     SUBTYPE IS NONSTATIC, THEN ANY VALUE OF THE EXPRESSION'S
29--     BASE TYPE MAY APPEAR AS A CHOICE.
30
31-- HISTORY:
32--     BCB 07/13/88  CREATED ORIGINAL TEST.
33
34WITH REPORT; USE REPORT;
35
36PROCEDURE C54A13C IS
37
38     L : INTEGER := 1;
39     R : INTEGER := 100;
40
41     SUBTYPE INT IS INTEGER RANGE L .. R;
42
43     A : INT := 50;
44
45     B : INTEGER := 50;
46
47     C : INTEGER;
48
49BEGIN
50     TEST ("C54A13C", "CHECK THAT IF A CASE EXPRESSION IS A " &
51                      "QUALIFIED EXPRESSION, A TYPE CONVERSION, " &
52                      "OR ONE OF THESE IN PARENTHESES, AND ITS " &
53                      "SUBTYPE IS NONSTATIC, THEN ANY VALUE OF THE " &
54                      "EXPRESSION'S BASE TYPE MAY APPEAR AS A CHOICE");
55
56     CASE INT'(A) IS
57          WHEN 0 => C := IDENT_INT (5);
58          WHEN 50 => C := IDENT_INT (10);
59          WHEN -3000 => C := IDENT_INT (15);
60          WHEN OTHERS => C := IDENT_INT (20);
61     END CASE;
62
63     IF C /= IDENT_INT (10) THEN
64          FAILED ("INCORRECT CHOICE MADE FOR QUALIFIED EXPRESSION IN " &
65                  "CASE");
66     END IF;
67
68     CASE INT(B) IS
69          WHEN 0 => C := IDENT_INT (5);
70          WHEN 50 => C := IDENT_INT (10);
71          WHEN -3000 => C := IDENT_INT (15);
72          WHEN OTHERS => C := IDENT_INT (20);
73     END CASE;
74
75     IF C /= IDENT_INT (10) THEN
76          FAILED ("INCORRECT CHOICE MADE FOR TYPE CONVERSION IN CASE");
77     END IF;
78
79     CASE (INT'(A)) IS
80          WHEN 0 => C := IDENT_INT (5);
81          WHEN 50 => C := IDENT_INT (10);
82          WHEN -3000 => C := IDENT_INT (15);
83          WHEN OTHERS => C := IDENT_INT (20);
84     END CASE;
85
86     IF C /= IDENT_INT (10) THEN
87          FAILED ("INCORRECT CHOICE MADE FOR QUALIFIED EXPRESSION IN " &
88                  "PARENTHESES IN CASE");
89     END IF;
90
91     CASE (INT(B)) IS
92          WHEN 0 => C := IDENT_INT (5);
93          WHEN 50 => C := IDENT_INT (10);
94          WHEN -3000 => C := IDENT_INT (15);
95          WHEN OTHERS => C := IDENT_INT (20);
96     END CASE;
97
98     IF C /= IDENT_INT (10) THEN
99          FAILED ("INCORRECT CHOICE MADE FOR TYPE CONVERSION IN " &
100                  "PARENTHESES IN CASE");
101     END IF;
102
103     RESULT;
104END C54A13C;
105