1-- C54A13D.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 FUNCTION INVOCATION,
27--     ATTRIBUTE, STATIC EXPRESSION, OR ONE OF THESE IN PARENTHESES,
28--     THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE MAY APPEAR AS A
29--     CHOICE.
30
31-- HISTORY:
32--     BCB 07/19/88  CREATED ORIGINAL TEST.
33--     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
34--     GJD 11/15/95  REMOVED ADA 95 INCOMPATIBLE ALTERNATIVE IN FIRST CASE.
35
36WITH REPORT; USE REPORT;
37
38PROCEDURE C54A13D IS
39
40     SUBTYPE INT IS INTEGER RANGE -100 .. 100;
41
42     CONS : CONSTANT INT := 0;
43
44     C : INT;
45
46     TYPE ENUM IS (ONE, TWO, THREE, FOUR, FIVE, SIX);
47
48     SUBTYPE SUBENUM IS ENUM RANGE THREE .. FOUR;
49
50     FUNCTION FUNC RETURN INT IS
51     BEGIN
52          RETURN 0;
53     END FUNC;
54
55BEGIN
56     TEST ("C54A13D", "CHECK THAT IF A CASE EXPRESSION IS A FUNCTION " &
57                      "INVOCATION, ATTRIBUTE, STATIC EXPRESSION, OR " &
58                      "ONE OF THESE IN PARENTHESES, THEN ANY VALUE " &
59                      "OF THE EXPRESSION'S BASE TYPE MAY APPEAR AS " &
60                      "A CHOICE");
61
62     CASE FUNC IS
63          WHEN 0 => C := IDENT_INT (5);
64          WHEN 100 => C := IDENT_INT (10);
65          WHEN OTHERS => C := IDENT_INT (20);
66     END CASE;
67
68     IF NOT EQUAL (C,5) THEN
69          FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
70                  "FUNCTION INVOCATION - 1");
71     END IF;
72
73     CASE (FUNC) IS
74          WHEN 0 => C := IDENT_INT (25);
75          WHEN 100 => C := IDENT_INT (50);
76          WHEN -3000 => C := IDENT_INT (75);
77          WHEN OTHERS => C := IDENT_INT (90);
78     END CASE;
79
80     IF NOT EQUAL (C,25) THEN
81          FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
82                  "FUNCTION INVOCATION - 2");
83     END IF;
84
85     CASE SUBENUM'FIRST IS
86          WHEN ONE => C := IDENT_INT (100);
87          WHEN TWO => C := IDENT_INT (99);
88          WHEN THREE => C := IDENT_INT (98);
89          WHEN FOUR => C := IDENT_INT (97);
90          WHEN FIVE => C := IDENT_INT (96);
91          WHEN SIX => C := IDENT_INT (95);
92     END CASE;
93
94     IF NOT EQUAL (C,98) THEN
95          FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS AN " &
96                  "ATTRIBUTE - 1");
97     END IF;
98
99     CASE (SUBENUM'FIRST) IS
100          WHEN ONE => C := IDENT_INT (90);
101          WHEN TWO => C := IDENT_INT (89);
102          WHEN THREE => C := IDENT_INT (88);
103          WHEN FOUR => C := IDENT_INT (87);
104          WHEN FIVE => C := IDENT_INT (86);
105          WHEN SIX => C := IDENT_INT (85);
106     END CASE;
107
108     IF NOT EQUAL (C,88) THEN
109          FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS AN " &
110                  "ATTRIBUTE - 2");
111     END IF;
112
113     CASE CONS * 1 IS
114          WHEN 0 => C := IDENT_INT (1);
115          WHEN 100 => C := IDENT_INT (2);
116          WHEN -3000 => C := IDENT_INT (3);
117          WHEN OTHERS => C := IDENT_INT (4);
118     END CASE;
119
120     IF NOT EQUAL (C,1) THEN
121          FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
122                  "STATIC EXPRESSION - 1");
123     END IF;
124
125     CASE (CONS * 1) IS
126          WHEN 0 => C := IDENT_INT (10);
127          WHEN 100 => C := IDENT_INT (20);
128          WHEN -3000 => C := IDENT_INT (30);
129          WHEN OTHERS => C := IDENT_INT (40);
130     END CASE;
131
132     IF NOT EQUAL (C,10) THEN
133          FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
134                  "STATIC EXPRESSION - 2");
135     END IF;
136
137     RESULT;
138END C54A13D;
139