2003-12-26 Guilhem Lavaux <guilhem@kaffe.org>
[official-gcc.git] / gcc / testsuite / ada / acats / tests / c5 / c54a13a.ada
blob949de81123c189ab5017bf6f9cb9506c502781f4
1 -- C54A13A.ADA
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.
16 -- DISCLAIMER
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 DECLARED VARIABLE OR
27 -- CONSTANT, OR ONE OF THESE IN PARENTHESES, AND ITS SUBTYPE IS
28 -- NONSTATIC, THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE MAY
29 -- APPEAR AS A CHOICE.
31 -- HISTORY:
32 -- BCB 02/29/88 CREATED ORIGINAL TEST.
34 WITH REPORT; USE REPORT;
36 PROCEDURE C54A13A IS
38 SUBTYPE INT IS INTEGER RANGE IDENT_INT(5) .. IDENT_INT(10);
40 A : INT := 8;
41 B : CONSTANT INT := 7;
42 C, D : INTEGER;
44 FUNCTION IDENT(X : INT) RETURN INT IS
45 BEGIN
46 IF EQUAL(3,3) THEN
47 RETURN X;
48 ELSE
49 RETURN 0;
50 END IF;
51 END IDENT;
53 BEGIN
54 TEST ("C54A13A", "CHECK THAT IF A CASE EXPRESSION IS A DECLARED " &
55 "VARIABLE OR CONSTANT, OR ONE OF THESE IN " &
56 "PARENTHESES, AND ITS SUBTYPE IS NONSTATIC, " &
57 "THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE " &
58 "MAY APPEAR AS A CHOICE");
60 CASE A IS
61 WHEN 0 => C := IDENT_INT(5);
62 WHEN 8 => C := IDENT_INT(10);
63 WHEN 30000 => C := IDENT_INT(15);
64 WHEN -30000 => C := IDENT_INT(20);
65 WHEN OTHERS => C := IDENT_INT(25);
66 END CASE;
68 IF C /= IDENT_INT(10) THEN
69 FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 1");
70 END IF;
72 CASE B IS
73 WHEN 0 => D := IDENT_INT(5);
74 WHEN 100 => D := IDENT_INT(10);
75 WHEN 30000 => D := IDENT_INT(15);
76 WHEN -30000 => D := IDENT_INT(20);
77 WHEN OTHERS => D := IDENT_INT(25);
78 END CASE;
80 IF D /= IDENT_INT(25) THEN
81 FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 2");
82 END IF;
84 CASE (A) IS
85 WHEN 0 => C := IDENT_INT(5);
86 WHEN 8 => C := IDENT_INT(10);
87 WHEN 30000 => C := IDENT_INT(15);
88 WHEN -30000 => C := IDENT_INT(20);
89 WHEN OTHERS => C := IDENT_INT(25);
90 END CASE;
92 IF C /= IDENT_INT(10) THEN
93 FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 3");
94 END IF;
96 CASE (B) IS
97 WHEN 0 => D := IDENT_INT(5);
98 WHEN 110 => D := IDENT_INT(10);
99 WHEN 30000 => D := IDENT_INT(15);
100 WHEN -30000 => D := IDENT_INT(20);
101 WHEN OTHERS => D := IDENT_INT(25);
102 END CASE;
104 IF D /= IDENT_INT(25) THEN
105 FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 4");
106 END IF;
108 RESULT;
109 END C54A13A;