Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c9/c96001a.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 -- C96001A.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 A DELAY STATEMENT DELAYS EXECUTION FOR AT LEAST THE
27 -- SPECIFIED TIME. SPECIFICALLY,
28 -- (A) POSITIVE DELAY ARGUMENT.
29 -- (B) NEGATIVE DELAY ARGUMENT.
30 -- (C) ZERO DELAY ARGUMENT.
31 -- (D) DURATION'SMALL DELAY ARGUMENT.
32 -- (E) EXPRESSION OF TYPE DURATION AS DELAY ARGUMENT.
33
34 -- HISTORY:
35 -- CPP 8/14/84 CREATED ORIGINAL TEST.
36 -- RJW 11/13/87 ADDED CODE WHICH ALLOWS TEST TO REPORT "PASSED"
37 -- IF TICK > DURATION'SMALL.
38
39 with Impdef;
40 WITH CALENDAR; USE CALENDAR;
41 WITH SYSTEM; USE SYSTEM;
42 WITH REPORT; USE REPORT;
43 PROCEDURE C96001A IS
44
45 SUBTYPE INT IS INTEGER RANGE 0 .. 20_000;
46
47 BEGIN
48 TEST ("C96001A", "CHECK THAT DELAY STATEMENT DELAYS " &
49 "EXECUTION FOR AT LEAST THE SPECIFIED TIME");
50
51 ---------------------------------------------
52
53 DECLARE -- (A)
54 X : DURATION := 5.0 * Impdef.One_Second;
55 OLD_TIME : TIME;
56 LAPSE : DURATION;
57 BEGIN -- (A)
58 LOOP
59 OLD_TIME := CLOCK;
60 DELAY X;
61 LAPSE := CLOCK - OLD_TIME;
62 EXIT;
63 END LOOP;
64 IF LAPSE < X THEN
65 FAILED ("DELAY DID NOT LAPSE AT LEAST 5.0 " &
66 "SECONDS - (A)");
67 END IF;
68 EXCEPTION
69 WHEN OTHERS =>
70 FAILED ("EXCEPTION RAISED - (A)");
71 END;
72
73 ---------------------------------------------
74
75 DECLARE -- (B)
76 OLD_TIME : TIME;
77 LAPSE : DURATION;
78 BEGIN -- (B)
79 LOOP
80 OLD_TIME := CLOCK;
81 DELAY -5.0;
82 LAPSE := CLOCK - OLD_TIME;
83 EXIT;
84 END LOOP;
85 COMMENT ("(B) - NEGATIVE DELAY LAPSED FOR " &
86 INT'IMAGE (INT (LAPSE * 1_000)) & " MILLISECONDS");
87 EXCEPTION
88 WHEN OTHERS =>
89 FAILED ("EXCEPTION RAISED - (B)");
90 END;
91
92 ---------------------------------------------
93
94 DECLARE -- (C)
95 X : DURATION := 0.0;
96 OLD_TIME : TIME;
97 LAPSE : DURATION;
98 BEGIN -- (C)
99 LOOP
100 OLD_TIME := CLOCK;
101 DELAY X;
102 LAPSE := CLOCK - OLD_TIME;
103 EXIT;
104 END LOOP;
105 COMMENT ("(C) - ZERO DELAY LAPSED FOR " &
106 INT'IMAGE (INT (LAPSE * 1_000)) & " MILLISECONDS");
107 EXCEPTION
108 WHEN OTHERS =>
109 FAILED ("EXCEPTION RAISED - (C)");
110 END;
111
112 ---------------------------------------------
113
114 DECLARE -- (D)
115 X : DURATION := DURATION'SMALL;
116 OLD_TIME : TIME;
117 LAPSE : DURATION;
118 BEGIN -- (D)
119 LOOP
120 OLD_TIME := CLOCK;
121 DELAY X;
122 LAPSE := CLOCK - OLD_TIME;
123 EXIT;
124 END LOOP;
125 IF LAPSE < X THEN
126 IF TICK < DURATION'SMALL THEN
127 FAILED ("DELAY DID NOT LAPSE AT LEAST " &
128 "DURATION'SMALL SECONDS - (D)");
129 ELSE
130 COMMENT ("TICK > DURATION'SMALL SO DELAY IN " &
131 "'(D)' IS NOT MEASURABLE");
132 END IF;
133 END IF;
134 EXCEPTION
135 WHEN OTHERS =>
136 FAILED ("EXCEPTION RAISED - (D)");
137 END;
138
139 ---------------------------------------------
140
141 DECLARE -- (E)
142 INC1 : DURATION := 2.0 * Impdef.One_Second;
143 INC2 : DURATION := 3.0 * Impdef.One_Second;
144 OLD_TIME : TIME;
145 LAPSE : DURATION;
146 BEGIN -- (E)
147 LOOP
148 OLD_TIME := CLOCK;
149 DELAY INC1 + INC2;
150 LAPSE := CLOCK - OLD_TIME;
151 EXIT;
152 END LOOP;
153 IF LAPSE < (INC1 + INC2) THEN
154 FAILED ("DELAY DID NOT LAPSE AT LEAST " &
155 "INC1 + INC2 SECONDS - (E)");
156 END IF;
157 EXCEPTION
158 WHEN OTHERS =>
159 FAILED ("EXCEPTION RAISED - (E)");
160 END;
161
162 RESULT;
163 END C96001A;