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

4.115
Last change on this file since c499856 was c499856, checked in by Chris Johns <chrisj@…>, on 03/20/14 at 21:10:47

Change all references of rtems.com to rtems.org.

  • Property mode set to 100644
File size: 4.5 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-2011.
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.org/license/LICENSE.
19--
20
21with INTERFACES; use INTERFACES;
22with RTEMS_CALLING_OVERHEAD;
23with TEST_SUPPORT;
24with TEXT_IO;
25with TIME_TEST_SUPPORT;
26with TIMER_DRIVER;
27with RTEMS.SEMAPHORE;
28
29package body TMTEST is
30
31--
32--  INIT
33--
34
35   procedure INIT (
36      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
37   ) is
38      pragma Unreferenced(ARGUMENT);
39      TASK_ID : RTEMS.ID;
40      STATUS  : RTEMS.STATUS_CODES;
41   begin
42
43      TEXT_IO.NEW_LINE( 2 );
44      TEXT_IO.PUT_LINE( "*** TIME TEST 3 ***" );
45
46      RTEMS.TASKS.CREATE(
47         RTEMS.BUILD_NAME( 'T', 'A', '1', ' ' ),
48         252,
49         2048,
50         RTEMS.DEFAULT_MODES,
51         RTEMS.DEFAULT_ATTRIBUTES,
52         TASK_ID,
53         STATUS
54      );
55      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TEST_INIT" );
56
57      RTEMS.TASKS.START( TASK_ID, TMTEST.TEST_INIT'ACCESS, 0, STATUS );
58      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TEST_INIT" );
59
60      RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
61      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
62
63   end INIT;
64
65--
66--  TEST_INIT
67--
68
69   procedure TEST_INIT (
70      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
71   ) is
72      pragma Unreferenced(ARGUMENT);
73      PRIORITY : RTEMS.TASKS.PRIORITY;
74      TASK_ID  : RTEMS.ID;
75      STATUS   : RTEMS.STATUS_CODES;
76   begin
77
78      PRIORITY := 250;
79 
80      RTEMS.SEMAPHORE.CREATE(
81         RTEMS.BUILD_NAME( 'S', 'M', '1', ' ' ),
82         0,
83         RTEMS.DEFAULT_ATTRIBUTES,
84         RTEMS.TASKS.NO_PRIORITY,
85         TMTEST.SEMAPHORE_ID,
86         STATUS
87      );
88      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_CREATE OF SM1" );
89
90      for INDEX in 2 .. TIME_TEST_SUPPORT.OPERATION_COUNT
91      loop
92
93         RTEMS.TASKS.CREATE(
94            RTEMS.BUILD_NAME( 'M', 'I', 'D', ' ' ),
95            PRIORITY,
96            1024,
97            RTEMS.DEFAULT_MODES,
98            RTEMS.DEFAULT_ATTRIBUTES,
99            TASK_ID,
100            STATUS
101         );
102         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE MIDDLE" );
103
104         PRIORITY := PRIORITY - 1;
105
106         RTEMS.TASKS.START( TASK_ID, TMTEST.MIDDLE_TASKS'ACCESS, 0, STATUS );
107         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START MIDDLE" );
108
109      end loop;
110
111      RTEMS.TASKS.CREATE(
112         RTEMS.BUILD_NAME( 'H', 'I', 'G', 'H' ),
113         PRIORITY,
114         1024,
115         RTEMS.DEFAULT_MODES,
116         RTEMS.DEFAULT_ATTRIBUTES,
117         TASK_ID,
118         STATUS
119      );
120      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF HIGH TASK" );
121
122      RTEMS.TASKS.START( TASK_ID, TMTEST.HIGH_TASK'ACCESS, 0, STATUS );
123      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF HIGH TASK" );
124
125      TIMER_DRIVER.INITIALIZE;
126      RTEMS.SEMAPHORE.RELEASE( TMTEST.SEMAPHORE_ID, STATUS );
127      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE" );
128
129   end TEST_INIT;
130
131--
132--  MIDDLE_TASKS
133--
134
135   procedure MIDDLE_TASKS (
136      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
137   ) is
138      pragma Unreferenced(ARGUMENT);
139      STATUS   : RTEMS.STATUS_CODES;
140   begin
141   
142      RTEMS.SEMAPHORE.OBTAIN(
143         TMTEST.SEMAPHORE_ID,
144         RTEMS.DEFAULT_OPTIONS,
145         RTEMS.NO_TIMEOUT,
146         STATUS
147      );
148      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN" );
149
150      RTEMS.SEMAPHORE.RELEASE( TMTEST.SEMAPHORE_ID, STATUS );
151      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE" );
152
153   end MIDDLE_TASKS;
154
155--
156--  HIGH_TASK
157--
158
159   procedure HIGH_TASK (
160      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
161   ) is
162      pragma Unreferenced(ARGUMENT);
163      STATUS   : RTEMS.STATUS_CODES;
164   begin
165   
166      RTEMS.SEMAPHORE.OBTAIN(
167         TMTEST.SEMAPHORE_ID,
168         RTEMS.DEFAULT_OPTIONS,
169         RTEMS.NO_TIMEOUT,
170         STATUS
171      );
172
173      TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
174
175      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "LAST CALL DID NOT WORK" );
176
177      TIME_TEST_SUPPORT.PUT_TIME(
178         "SEMAPHORE_RELEASE (preemptive)",
179         TMTEST.END_TIME,
180         TIME_TEST_SUPPORT.OPERATION_COUNT,
181         0,
182         RTEMS_CALLING_OVERHEAD.SEMAPHORE_RELEASE
183      );
184
185      TEXT_IO.PUT_LINE( "*** END OF TIME TEST 3 ***" );
186      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
187
188   end HIGH_TASK;
189
190end TMTEST;
Note: See TracBrowser for help on using the repository browser.