Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cc/cc3125d.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 -- CC3125D.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 CONSTRAINT_ERROR IS RAISED FOR A GENERIC IN PARAMETER
26 -- HAVING A FIXED POINT TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL
27 -- PARAMETER LIES OUTSIDE THE RANGE OF THE FORMAL PARAMETER.
28
29 -- TBN 12/15/86
30
31 WITH REPORT; USE REPORT;
32 PROCEDURE CC3125D IS
33
34 TYPE FIXED IS DELTA 0.125 RANGE -10.0 .. 10.0;
35 SUBTYPE FIX IS FIXED RANGE -5.0 .. 5.0;
36
37 FUNCTION IDENT_FIX (X : FIXED) RETURN FIXED IS
38 BEGIN
39 IF EQUAL (3, 3) THEN
40 RETURN X;
41 END IF;
42 RETURN 0.0;
43 END IDENT_FIX;
44
45 BEGIN
46 TEST ("CC3125D", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
47 "GENERIC IN PARAMETER HAVING A FIXED POINT " &
48 "TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL " &
49 "PARAMETER LIES OUTSIDE THE RANGE OF THE " &
50 "FORMAL PARAMETER");
51 DECLARE
52 GENERIC
53 GEN_FIX : IN FIX;
54 PACKAGE P IS
55 PAC_FIX : FIXED := GEN_FIX;
56 END P;
57 BEGIN
58 BEGIN
59 DECLARE
60 PACKAGE P1 IS NEW P(IDENT_FIX(-5.0));
61 BEGIN
62 IF P1.PAC_FIX /= IDENT_FIX(-5.0) THEN
63 FAILED ("INCORRECT VALUE PASSED - 1");
64 END IF;
65 END;
66 EXCEPTION
67 WHEN OTHERS =>
68 FAILED ("EXCEPTION RAISED - 1");
69 END;
70
71 BEGIN
72 DECLARE
73 PACKAGE P2 IS NEW P(IDENT_FIX(-5.2));
74 BEGIN
75 FAILED ("NO EXCEPTION RAISED - 2");
76 END;
77 EXCEPTION
78 WHEN CONSTRAINT_ERROR =>
79 NULL;
80 WHEN OTHERS =>
81 FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
82 END;
83
84 BEGIN
85 DECLARE
86 PACKAGE P3 IS NEW P(IDENT_FIX(5.2));
87 BEGIN
88 FAILED ("NO EXCEPTION RAISED - 3");
89 END;
90 EXCEPTION
91 WHEN CONSTRAINT_ERROR =>
92 NULL;
93 WHEN OTHERS =>
94 FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
95 END;
96 END;
97 -------------------------------------------------------------------
98
99 DECLARE
100 GENERIC
101 TYPE GEN_TYP IS DELTA <>;
102 GEN_FIX : IN GEN_TYP;
103 PACKAGE Q IS
104 PAC_FIX : GEN_TYP := GEN_FIX;
105 END Q;
106 BEGIN
107 BEGIN
108 DECLARE
109 PACKAGE Q1 IS NEW Q(FIX, IDENT_FIX(5.0));
110 BEGIN
111 IF Q1.PAC_FIX /= IDENT_FIX(5.0) THEN
112 FAILED ("INCORRECT VALUE PASSED - 4");
113 END IF;
114 END;
115 EXCEPTION
116 WHEN OTHERS =>
117 FAILED ("EXCEPTION RAISED - 4");
118 END;
119
120 BEGIN
121 DECLARE
122 PACKAGE Q2 IS NEW Q(FIX, IDENT_FIX(-5.2));
123 BEGIN
124 FAILED ("NO EXCEPTION RAISED - 5");
125 END;
126 EXCEPTION
127 WHEN CONSTRAINT_ERROR =>
128 NULL;
129 WHEN OTHERS =>
130 FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
131 END;
132
133 BEGIN
134 DECLARE
135 PACKAGE Q3 IS NEW Q(FIX, IDENT_FIX(5.2));
136 BEGIN
137 FAILED ("NO EXCEPTION RAISED - 6");
138 END;
139 EXCEPTION
140 WHEN CONSTRAINT_ERROR =>
141 NULL;
142 WHEN OTHERS =>
143 FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
144 END;
145 END;
146
147 RESULT;
148 END CC3125D;