OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c960001.a] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C960001.A
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
--
26
-- OBJECTIVE:
27
--      Confirm that a simple Delay Until statement is performed.  Check
28
--      that the delay does not complete before the requested time and that it
29
--      does complete thereafter
30
--
31
-- TEST DESCRIPTION:
32
--      Simulate a task that sends a "pulse" at regular intervals.  The Delay
33
--      Until statement is used to avoid accumulated drift.  For the
34
--      test, we expect the delay to return very close to the requested time;
35
--      we use an additional Pulse_Time_Delta for the limit.  The test
36
--      driver (main) artificially limits the number of iterations by setting
37
--      the Stop_Pulse Boolean after a small number.
38
--
39
--
40
-- CHANGE HISTORY:
41
--      06 Dec 94   SAIC    ACVC 2.0
42
--      15 Nov 95   SAIC    Fixed global variable problem for ACVC 2.0.1
43
--
44
--!
45
 
46
with Report;
47
with Ada.Calendar;
48
with ImpDef;
49
 
50
procedure C960001 is
51
 
52
begin
53
 
54
   Report.Test ("C960001", "Simple Delay Until");
55
 
56
   declare  -- To get the Report.Result after all has completed
57
 
58
      function "+" (Left : Ada.Calendar.Time; Right: Duration)
59
                            return Ada.Calendar.Time renames Ada.Calendar."+";
60
      function "<" (Left, Right : Ada.Calendar.Time)
61
                            return Boolean       renames Ada.Calendar."<";
62
      function ">" (Left, Right : Ada.Calendar.Time)
63
                            return Boolean       renames Ada.Calendar.">";
64
 
65
      TC_Loop_Count : integer range 0..4 := 0;
66
 
67
 
68
      -- control over stopping tasks
69
      protected Control is
70
         procedure Stop_Now;
71
         function Stop return Boolean;
72
      private
73
         Halt : Boolean := False;
74
      end Control;
75
 
76
      protected body Control is
77
         procedure Stop_Now is
78
         begin
79
            Halt := True;
80
         end Stop_Now;
81
 
82
         function Stop return Boolean is
83
         begin
84
            return Halt;
85
         end Stop;
86
      end Control;
87
 
88
      task Pulse_Task is
89
         entry Trigger;
90
      end Pulse_Task;
91
 
92
 
93
      -- Task to synchronize all qualified receivers.
94
      -- The entry Trigger starts the synchronization; Control.Stop
95
      -- becoming true terminates the task.
96
      --
97
      task body Pulse_Task is
98
 
99
         Pulse_Time       : Ada.Calendar.Time;
100
 
101
         Pulse_Time_Delta : duration :=  ImpDef.Clear_Ready_Queue;
102
 
103
         TC_Last_Time : Ada.Calendar.Time;
104
         TC_Current   : Ada.Calendar.Time;
105
 
106
 
107
         -- This routine transmits a synchronizing "pulse" to
108
         -- all receivers
109
         procedure Pulse is
110
         begin
111
            null;  -- Stub
112
            Report.Comment (".......PULSE........");
113
         end Pulse;
114
 
115
      begin
116
         accept Trigger;
117
 
118
         Pulse_Time   := Ada.Calendar.Clock + Pulse_Time_Delta;
119
         TC_Last_Time := Pulse_Time;
120
 
121
         while not Control.Stop loop
122
            delay until Pulse_Time;
123
            Pulse;
124
 
125
            -- Calculate time for next pulse.  Note: this is based on the
126
            -- last pulse time, not the time we returned from the delay
127
            --
128
            Pulse_Time := Pulse_Time + Pulse_Time_Delta;
129
 
130
            -- Test Control:
131
            TC_Current := Ada.Calendar.Clock;
132
            if TC_Current < TC_Last_Time then
133
               Report.Failed ("Delay expired before requested time");
134
            end if;
135
            if TC_Current > Pulse_Time then
136
               Report.Failed ("Delay too long");
137
            end if;
138
            TC_Last_Time := Pulse_Time;
139
            TC_Loop_Count := TC_Loop_Count +1;
140
         end loop;
141
 
142
      exception
143
         when others =>
144
               Report.Failed ("Unexpected exception in Pulse_Task");
145
      end Pulse_Task;
146
 
147
 
148
 
149
   begin -- declare
150
 
151
      Pulse_Task.Trigger;      -- Start test
152
 
153
      -- Artificially limit the number of iterations
154
      while TC_Loop_Count < 3 loop
155
         delay ImpDef.Minimum_Task_Switch;
156
      end loop;
157
      --
158
      Control.Stop_Now;      -- End test
159
 
160
   end; -- declare
161
 
162
   Report.Result;
163
 
164
end C960001;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.