Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c4/c49023a.ada @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 -- C49023A.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 A CONSTANT DECLARED BY AN OBJECT DECLARATION CAN BE USED | |
26 -- IN A STATIC EXPRESSION IF THE CONSTANT WAS DECLARED WITH A STATIC | |
27 -- SUBTYPE AND INITIALIZED WITH A STATIC EXPRESSION. | |
28 | |
29 -- L.BROWN 10/01/86 | |
30 | |
31 WITH REPORT; USE REPORT; | |
32 PROCEDURE C49023A IS | |
33 | |
34 BEGIN | |
35 TEST("C49023A","A CONSTANT DECLARED BY AN OBJECT DECLARATION "& | |
36 "UNDER CERTAIN CONDITIONS CAN BE USED IN A "& | |
37 "STATIC EXPRESSION"); | |
38 DECLARE | |
39 TYPE ENUM IS (RED,GREEN,BLUE,YELLOW); | |
40 SUBTYPE SENUM IS ENUM RANGE RED .. BLUE; | |
41 CONEN : CONSTANT SENUM := GREEN; | |
42 TYPE INT IS RANGE 1 .. 10; | |
43 SUBTYPE SINT IS INT RANGE 1 .. 5; | |
44 CONIN : CONSTANT SINT := 3; | |
45 TYPE FLT IS DIGITS 3 RANGE 0.0 .. 25.0; | |
46 SUBTYPE SFLT IS FLT RANGE 10.0 .. 20.0; | |
47 CONFL : CONSTANT SFLT := 11.0; | |
48 TYPE FIX IS DELTA 0.25 RANGE 0.0 .. 25.0; | |
49 SUBTYPE SFIX IS FIX RANGE 0.0 .. 12.0; | |
50 CONFI : CONSTANT SFIX := 0.25; | |
51 CAS_EN : ENUM := CONEN; | |
52 TYPE ITEG IS RANGE 1 .. CONIN; | |
53 TYPE FLTY IS DIGITS CONIN; | |
54 TYPE FIXY IS DELTA CONFI RANGE 0.0 .. 10.0; | |
55 TYPE REAL IS DELTA 0.25 RANGE 0.0 .. 11.0; | |
56 TYPE FIXTY IS DELTA 0.25 RANGE 0.0 .. CONFL; | |
57 | |
58 FUNCTION IDENT_REAL (X : REAL) RETURN REAL; | |
59 | |
60 PACKAGE P IS | |
61 TYPE T IS PRIVATE; | |
62 CON1 : CONSTANT T; | |
63 PRIVATE | |
64 TYPE T IS NEW INTEGER; | |
65 CON1 : CONSTANT T := 10; | |
66 TYPE NINT IS RANGE 1 .. CON1; | |
67 END P; | |
68 PACKAGE BODY P IS | |
69 TYPE CON2 IS RANGE CON1 .. 50; | |
70 BEGIN | |
71 IF NINT'LAST /= NINT(IDENT_INT(10)) THEN | |
72 FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 1"); | |
73 END IF; | |
74 IF CON2'FIRST /= CON2(IDENT_INT(10)) THEN | |
75 FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 2"); | |
76 END IF; | |
77 END P; | |
78 | |
79 FUNCTION IDENT_REAL (X : REAL) RETURN REAL IS | |
80 BEGIN | |
81 IF EQUAL(3,3) THEN | |
82 RETURN X; | |
83 ELSE | |
84 RETURN 0.0; | |
85 END IF; | |
86 END IDENT_REAL; | |
87 | |
88 BEGIN | |
89 | |
90 IF ITEG'LAST /= ITEG(IDENT_INT(3)) THEN | |
91 FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 3"); | |
92 END IF; | |
93 | |
94 IF FLTY'DIGITS /= IDENT_INT(3) THEN | |
95 FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 4"); | |
96 END IF; | |
97 | |
98 IF FIXY'DELTA /= IDENT_REAL(0.25) THEN | |
99 FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 5"); | |
100 END IF; | |
101 | |
102 IF FIXTY'LAST /= FIXTY(IDENT_REAL(11.0)) THEN | |
103 FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 6"); | |
104 END IF; | |
105 | |
106 CASE CAS_EN IS | |
107 WHEN CONEN => | |
108 CAS_EN := RED; | |
109 WHEN OTHERS => | |
110 FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 7"); | |
111 END CASE; | |
112 | |
113 END; | |
114 | |
115 RESULT; | |
116 | |
117 END C49023A; |