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
39with Impdef;
40WITH CALENDAR;  USE CALENDAR;
41WITH SYSTEM;    USE SYSTEM;
42WITH REPORT;    USE REPORT;
43PROCEDURE C96001A IS
44
45     SUBTYPE INT IS INTEGER RANGE 0 .. 20_000;
46
47BEGIN
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;
163END C96001A;
164