source: rtems/c/src/ada-tests/tmtests/tm03/tmtest.adb @ 820901ba

4.104.114.84.95
Last change on this file since 820901ba was 820901ba, checked in by Joel Sherrill <joel.sherrill@…>, on 05/03/05 at 21:41:45

2005-05-03 Joel Sherrill <joel@…>

  • samples/hello/sptest.adb, sptests/sp03/sptest.adb, sptests/sp04/sptest.adb, sptests/sp05/sptest.adb, sptests/sp07/sptest.adb, sptests/sp13/sptest.adb, sptests/sp14/sptest.adb, sptests/sp20/sptest.adb, sptests/sp24/sptest.adb, tmtests/tm01/tmtest.adb, tmtests/tm02/tmtest.adb, tmtests/tm03/tmtest.adb, tmtests/tm04/tmtest.adb, tmtests/tm05/tmtest.adb, tmtests/tm06/tmtest.adb, tmtests/tm07/tmtest.adb, tmtests/tm08/tmtest.adb, tmtests/tm09/tmtest.adb, tmtests/tm10/tmtest.adb, tmtests/tm11/tmtest.adb, tmtests/tm12/tmtest.adb, tmtests/tm13/tmtest.adb, tmtests/tm14/tmtest.adb, tmtests/tm15/tmtest.adb, tmtests/tm16/tmtest.adb, tmtests/tm17/tmtest.adb, tmtests/tm18/tmtest.adb, tmtests/tm19/tmtest.adb, tmtests/tm20/tmtest.adb, tmtests/tm21/tmtest.adb, tmtests/tm22/tmtest.adb, tmtests/tm23/tmtest.adb, tmtests/tm24/tmtest.adb, tmtests/tm25/tmtest.adb, tmtests/tm28/tmtest.adb, tmtests/tm29/tmtest.adb, tmtests/tmck/tmtest.adb, tmtests/tmoverhd/dummy_rtems.adb, tmtests/tmoverhd/tmtest.adb: Remove warnings.
  • Property mode set to 100644
File size: 4.0 KB
Line 
1--
2--  TMTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation of Test 3 of the RTEMS
7--  Timing Test Suite.
8--
9--  DEPENDENCIES:
10--
11-- 
12--
13--  COPYRIGHT (c) 1989-1997.
14--  On-Line Applications Research Corporation (OAR).
15--
16--  The license and distribution terms for this file may in
17--  the file LICENSE in this distribution or at
18--  http://www.rtems.com/license/LICENSE.
19--
20--  $Id$
21--
22
23with INTERFACES; use INTERFACES;
24with RTEMS;
25with RTEMS_CALLING_OVERHEAD;
26with TEST_SUPPORT;
27with TEXT_IO;
28with TIME_TEST_SUPPORT;
29with UNSIGNED32_IO;
30
31package body TMTEST is
32
33--PAGE
34--
35--  INIT
36--
37
38   procedure INIT (
39      ARGUMENT : in     RTEMS.TASK_ARGUMENT
40   ) is
41      TASK_ID : RTEMS.ID;
42      STATUS  : RTEMS.STATUS_CODES;
43   begin
44
45      TEXT_IO.NEW_LINE( 2 );
46      TEXT_IO.PUT_LINE( "*** TIME TEST 3 ***" );
47
48      RTEMS.TASK_CREATE(
49         RTEMS.BUILD_NAME( 'T', 'A', '1', ' ' ),
50         252,
51         2048,
52         RTEMS.DEFAULT_MODES,
53         RTEMS.DEFAULT_ATTRIBUTES,
54         TASK_ID,
55         STATUS
56      );
57      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TEST_INIT" );
58
59      RTEMS.TASK_START( TASK_ID, TMTEST.TEST_INIT'ACCESS, 0, STATUS );
60      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TEST_INIT" );
61
62      RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
63      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
64
65   end INIT;
66
67--PAGE
68--
69--  TEST_INIT
70--
71
72   procedure TEST_INIT (
73      ARGUMENT : in     RTEMS.TASK_ARGUMENT
74   ) is
75      PRIORITY : RTEMS.TASK_PRIORITY;
76      TASK_ID  : RTEMS.ID;
77      STATUS   : RTEMS.STATUS_CODES;
78   begin
79
80      PRIORITY := 250;
81 
82      RTEMS.SEMAPHORE_CREATE(
83         RTEMS.BUILD_NAME( 'S', 'M', '1', ' ' ),
84         0,
85         RTEMS.DEFAULT_ATTRIBUTES,
86         RTEMS.NO_PRIORITY,
87         TMTEST.SEMAPHORE_ID,
88         STATUS
89      );
90      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_CREATE OF SM1" );
91
92      for INDEX in 2 .. TIME_TEST_SUPPORT.OPERATION_COUNT
93      loop
94
95         RTEMS.TASK_CREATE(
96            RTEMS.BUILD_NAME( 'M', 'I', 'D', ' ' ),
97            PRIORITY,
98            1024,
99            RTEMS.DEFAULT_MODES,
100            RTEMS.DEFAULT_ATTRIBUTES,
101            TASK_ID,
102            STATUS
103         );
104         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE MIDDLE" );
105
106         PRIORITY := PRIORITY - 1;
107
108         RTEMS.TASK_START( TASK_ID, TMTEST.MIDDLE_TASKS'ACCESS, 0, STATUS );
109         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START MIDDLE" );
110
111      end loop;
112
113      RTEMS.TASK_CREATE(
114         RTEMS.BUILD_NAME( 'H', 'I', 'G', 'H' ),
115         PRIORITY,
116         1024,
117         RTEMS.DEFAULT_MODES,
118         RTEMS.DEFAULT_ATTRIBUTES,
119         TASK_ID,
120         STATUS
121      );
122      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF HIGH TASK" );
123
124      RTEMS.TASK_START( TASK_ID, TMTEST.HIGH_TASK'ACCESS, 0, STATUS );
125      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF HIGH TASK" );
126
127      TIMER_DRIVER.INITIALIZE;
128      RTEMS.SEMAPHORE_RELEASE( TMTEST.SEMAPHORE_ID, STATUS );
129
130   end TEST_INIT;
131
132--PAGE
133--
134--  MIDDLE_TASKS
135--
136
137   procedure MIDDLE_TASKS (
138      ARGUMENT : in     RTEMS.TASK_ARGUMENT
139   ) is
140      STATUS   : RTEMS.STATUS_CODES;
141   begin
142   
143      RTEMS.SEMAPHORE_OBTAIN(
144         TMTEST.SEMAPHORE_ID,
145         RTEMS.DEFAULT_OPTIONS,
146         RTEMS.NO_TIMEOUT,
147         STATUS
148      );
149
150      RTEMS.SEMAPHORE_RELEASE( TMTEST.SEMAPHORE_ID, STATUS );
151
152   end MIDDLE_TASKS;
153
154--PAGE
155--
156--  HIGH_TASK
157--
158
159   procedure HIGH_TASK (
160      ARGUMENT : in     RTEMS.TASK_ARGUMENT
161   ) is
162      STATUS   : RTEMS.STATUS_CODES;
163   begin
164   
165      RTEMS.SEMAPHORE_OBTAIN(
166         TMTEST.SEMAPHORE_ID,
167         RTEMS.DEFAULT_OPTIONS,
168         RTEMS.NO_TIMEOUT,
169         STATUS
170      );
171
172      TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
173
174      TIME_TEST_SUPPORT.PUT_TIME(
175         "SEMAPHORE_RELEASE (preemptive)",
176         TMTEST.END_TIME,
177         TIME_TEST_SUPPORT.OPERATION_COUNT,
178         0,
179         RTEMS_CALLING_OVERHEAD.SEMAPHORE_RELEASE
180      );
181
182      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
183
184   end HIGH_TASK;
185
186end TMTEST;
Note: See TracBrowser for help on using the repository browser.