1-- C54A03A.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 BOOLEAN, CHARACTER, USER-DEFINED ENUMERATED, INTEGER,
26--    AND DERIVED TYPES MAY BE USED IN A CASE EXPRESSION.
27
28-- DAT 1/22/81
29-- PWB 4/22/86  RENAME TO -AB;
30--              REMOVE EXTRANEOUS <CR> FROM BEGINNING OF LINE 45.
31
32WITH REPORT;
33PROCEDURE C54A03A IS
34
35     USE REPORT;
36
37     TYPE D_INT IS NEW INTEGER RANGE 1 .. 2;
38     TYPE D_BOOL IS NEW BOOLEAN;
39     TYPE D_BOOL_2 IS NEW D_BOOL;
40     TYPE M_ENUM IS (FIRST, SECOND, THIRD);
41     TYPE M_CHAR IS NEW CHARACTER RANGE ASCII.NUL .. 'Z';
42     TYPE M_ENUM_2 IS NEW M_ENUM;
43
44     I : INTEGER := 1;
45     D_I : D_INT := 1;
46     B : BOOLEAN := TRUE;
47     D_B : D_BOOL := TRUE;
48     D_B_2 : D_BOOL_2 := FALSE;
49     E : M_ENUM := THIRD;
50     C : CHARACTER := 'A';
51     M_C : M_CHAR := 'Z';
52     D_E : M_ENUM_2 := SECOND;
53
54BEGIN
55     TEST ("C54A03A", "CHECK VARIOUS DISCRETE TYPES " &
56                      "IN CASE EXPRESSIONS");
57
58     CASE I IS
59          WHEN 2 | 3 => FAILED ("WRONG CASE 1");
60          WHEN 1 => NULL;
61          WHEN OTHERS => FAILED ("WRONG CASE 2");
62     END CASE;
63
64     CASE D_I IS
65          WHEN 1 => NULL;
66          WHEN 2 => FAILED ("WRONG CASE 2A");
67     END CASE;
68
69     CASE B IS
70          WHEN TRUE => NULL;
71          WHEN FALSE => FAILED ("WRONG CASE 3");
72     END CASE;
73
74     CASE D_B IS
75          WHEN TRUE => NULL;
76          WHEN FALSE => FAILED ("WRONG CASE 4");
77     END CASE;
78
79     CASE D_B_2 IS
80          WHEN FALSE => NULL;
81          WHEN TRUE => FAILED ("WRONG CASE 5");
82     END CASE;
83
84     CASE E IS
85          WHEN SECOND | FIRST => FAILED ("WRONG CASE 6");
86          WHEN THIRD => NULL;
87     END CASE;
88
89     CASE C IS
90          WHEN 'A' .. 'Z' => NULL;
91          WHEN OTHERS => FAILED ("WRONG CASE 7");
92     END CASE;
93
94     CASE M_C IS
95          WHEN 'Z' => NULL;
96          WHEN OTHERS => FAILED ("WRONG CASE 8");
97     END CASE;
98
99     CASE D_E IS
100          WHEN FIRST => FAILED ("WRONG CASE 9");
101          WHEN SECOND | THIRD => NULL;
102     END CASE;
103
104     RESULT;
105END C54A03A;
106