source: rtems/testsuites/ada/sptests/sp14/sptest.adb @ dda8142f

5
Last change on this file since dda8142f was f6c9334d, checked in by Sebastian Huber <sebastian.huber@…>, on 12/01/17 at 07:51:17

ada: Add standard test begin/end message
  • Property mode set to 100644
File size: 8.7 KB
Line 
1--
2--  SPTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation of Test 14 of the RTEMS
7--  Single Processor 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 ADDRESS_IO;
22with TEST_SUPPORT;
23with TEXT_IO;
24with UNSIGNED32_IO;
25with INTERFACES; use INTERFACES;
26with RTEMS.TIMER;
27with RTEMS.SIGNAL;
28
29package body SPTEST is
30
31--
32--  INIT
33--
34
35   procedure INIT (
36      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
37   ) is
38      pragma Unreferenced(ARGUMENT);
39      STATUS : RTEMS.STATUS_CODES;
40   begin
41
42      TEXT_IO.NEW_LINE( 2 );
43      TEST_SUPPORT.ADA_TEST_BEGIN;
44
45      SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'A', '1', ' ' );
46      SPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  'T', 'A', '2', ' ' );
47
48      RTEMS.TASKS.CREATE(
49         SPTEST.TASK_NAME( 1 ),
50         1,
51         RTEMS.MINIMUM_STACK_SIZE * 2,
52         RTEMS.DEFAULT_MODES,
53         RTEMS.DEFAULT_ATTRIBUTES,
54         SPTEST.TASK_ID( 1 ),
55         STATUS
56      );
57      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
58
59      RTEMS.TASKS.CREATE(
60         SPTEST.TASK_NAME( 2 ),
61         1,
62         RTEMS.MINIMUM_STACK_SIZE * 2,
63         RTEMS.DEFAULT_MODES,
64         RTEMS.DEFAULT_ATTRIBUTES,
65         SPTEST.TASK_ID( 2 ),
66         STATUS
67      );
68      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA2" );
69
70      RTEMS.TASKS.START(
71         SPTEST.TASK_ID( 1 ),
72         SPTEST.TASK_1'ACCESS,
73         0,
74         STATUS
75      );
76      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
77
78      RTEMS.TASKS.START(
79         SPTEST.TASK_ID( 2 ),
80         SPTEST.TASK_2'ACCESS,
81         0,
82         STATUS
83      );
84      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA2" );
85
86      SPTEST.TIMER_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'M', '1', ' ' );
87
88      RTEMS.TIMER.CREATE(
89         SPTEST.TIMER_NAME( 1 ),
90         SPTEST.TIMER_ID( 1 ),
91         STATUS
92      );
93      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM1" );
94
95      RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
96      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
97
98   end INIT;
99
100--
101--  SIGNAL_3_TO_TASK_1
102--
103
104   procedure SIGNAL_3_TO_TASK_1 (
105      ID      : in     RTEMS.ID;
106      POINTER : in     RTEMS.ADDRESS
107   ) is
108      STATUS : RTEMS.STATUS_CODES;
109   begin
110
111      RTEMS.SIGNAL.SEND( SPTEST.TASK_ID( 1 ), RTEMS.SIGNAL_3, STATUS );
112      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SIGNAL_SEND of 3" );
113
114      SPTEST.TIMER_GOT_THIS_ID      := ID;
115      SPTEST.TIMER_GOT_THIS_POINTER := POINTER;
116
117      SPTEST.SIGNAL_SENT := TRUE;
118
119   end SIGNAL_3_TO_TASK_1;
120
121--
122--  TASK_1
123--
124
125   procedure TASK_1 (
126      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
127   ) is
128      pragma Unreferenced(ARGUMENT);
129      PREVIOUS_MODE : RTEMS.MODE;
130      STATUS        : RTEMS.STATUS_CODES;
131   begin
132
133      TEXT_IO.PUT_LINE( "TA1 - signal_catch - INTERRUPT_LEVEL( 3 )" );
134      RTEMS.SIGNAL.CATCH(
135         SPTEST.PROCESS_ASR'ACCESS,
136         RTEMS.INTERRUPT_LEVEL( 3 ),
137         STATUS
138      );
139      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SIGNAL_CATCH INTERRUPT(3)" );
140   
141      TEXT_IO.PUT_LINE( "TA1 - signal_send - SIGNAL_16 to self" );
142      RTEMS.SIGNAL.SEND( RTEMS.SELF, RTEMS.SIGNAL_16, STATUS );
143      TEST_SUPPORT.DIRECTIVE_FAILED(
144         STATUS,
145         "SIGNAL_SEND - SIGNAL_16 to SELF"
146      );
147
148      TEXT_IO.PUT_LINE( "TA1 - signal_send - SIGNAL_0 to self" );
149      RTEMS.SIGNAL.SEND( RTEMS.SELF, RTEMS.SIGNAL_0, STATUS );
150      TEST_SUPPORT.DIRECTIVE_FAILED(
151         STATUS,
152         "SIGNAL_SEND - SIGNAL_0 to SELF"
153      );
154
155      TEXT_IO.PUT_LINE( "TA1 - signal_catch - NO_ASR" );
156      RTEMS.SIGNAL.CATCH(SPTEST.PROCESS_ASR'ACCESS, RTEMS.NO_ASR, STATUS);
157      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SIGNAL_CATCH - NO_ASR" );
158
159      TEST_SUPPORT.PAUSE;
160
161      TEXT_IO.PUT_LINE( "TA1 - signal_send - SIGNAL_1 to self" );
162      RTEMS.SIGNAL.SEND( RTEMS.SELF, RTEMS.SIGNAL_1, STATUS );
163      TEST_SUPPORT.DIRECTIVE_FAILED(
164         STATUS,
165         "SIGNAL_SEND - SIGNAL_1 to SELF"
166      );
167
168      TEXT_IO.PUT_LINE( "TA1 - task_mode - disable ASRs" );
169      RTEMS.TASKS.MODE(
170         RTEMS.NO_ASR,
171         RTEMS.ASR_MASK,
172         PREVIOUS_MODE,
173         STATUS
174      );
175      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_MODE" );
176
177      SPTEST.TIMER_GOT_THIS_ID := 0;
178      SPTEST.TIMER_GOT_THIS_POINTER := RTEMS.NULL_ADDRESS;
179
180      TEXT_IO.PUT_LINE( "TA1 - sending signal to SELF from timer" );
181      RTEMS.TIMER.FIRE_AFTER(
182         SPTEST.TIMER_ID( 1 ),
183         TEST_SUPPORT.TICKS_PER_SECOND / 2,
184         SPTEST.SIGNAL_3_TO_TASK_1'ACCESS,
185         SPTEST.TASK_1'ADDRESS,
186         STATUS
187      );
188      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER" );
189
190      TEXT_IO.PUT_LINE( "TA1 - waiting for signal to arrive" );
191
192      SPTEST.SIGNAL_SENT := FALSE;
193      SPTEST.ASR_FIRED   := FALSE;
194
195      loop
196         exit when SPTEST.SIGNAL_SENT;
197      end loop;
198
199      if SPTEST.TIMER_GOT_THIS_ID = SPTEST.TIMER_ID( 1 ) and then
200         RTEMS.ARE_EQUAL(SPTEST.TIMER_GOT_THIS_POINTER,
201             SPTEST.TASK_1'ADDRESS) then
202 
203         TEXT_IO.PUT_LINE( "TA1 - timer routine got the correct arguments" );
204
205      else
206
207         TEXT_IO.PUT( "TA1 - timer got (" );
208         UNSIGNED32_IO.PUT( SPTEST.TIMER_GOT_THIS_ID  );
209         TEXT_IO.PUT( "," );
210         ADDRESS_IO.PUT( SPTEST.TIMER_GOT_THIS_POINTER  );
211         TEXT_IO.PUT( ") instead of (" );
212         UNSIGNED32_IO.PUT( SPTEST.TIMER_ID( 1 ) );
213         TEXT_IO.PUT( "," );
214         ADDRESS_IO.PUT( SPTEST.TASK_1'ADDRESS  );
215         TEXT_IO.PUT_LINE( ")!!!!" );
216
217      end if;
218
219      TEXT_IO.PUT_LINE( "TA1 - task_mode - enable ASRs" );
220      RTEMS.TASKS.MODE(
221         RTEMS.ASR,
222         RTEMS.ASR_MASK,
223         PREVIOUS_MODE,
224         STATUS
225      );
226      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_MODE" );
227
228      TEXT_IO.PUT_LINE( "TA1 - signal_catch - ASR ADDRESS of NULL" );
229      RTEMS.SIGNAL.CATCH( NULL, RTEMS.DEFAULT_MODES, STATUS );
230      TEST_SUPPORT.DIRECTIVE_FAILED(
231         STATUS,
232         "SIGNAL_CATCH - NULL ADDRESS"
233      );
234   
235      TEXT_IO.PUT_LINE( "TA1 - task_delete - delete self" );
236      RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
237      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
238
239   end TASK_1;
240
241--
242--  TASK_2
243--
244
245   procedure TASK_2 (
246      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
247   ) is
248      pragma Unreferenced(ARGUMENT);
249      STATUS : RTEMS.STATUS_CODES;
250   begin
251
252      TEXT_IO.PUT_LINE( "TA2 - signal_send - SIGNAL_17 to TA1" );
253      RTEMS.SIGNAL.SEND( SPTEST.TASK_ID( 1 ), RTEMS.SIGNAL_17, STATUS );
254      TEST_SUPPORT.DIRECTIVE_FAILED(
255         STATUS,
256         "SIGNAL_SEND - SIGNAL_17 to TA1"
257      );
258
259      TEXT_IO.PUT_LINE( "TA2 - task_wake_after - yield processor" );
260      RTEMS.TASKS.WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
261      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER YIELD" );
262
263      TEXT_IO.PUT_LINE(
264         "TA2 - signal_send - SIGNAL_18 and SIGNAL_19 to TA1"
265      );
266      RTEMS.SIGNAL.SEND(
267         SPTEST.TASK_ID( 1 ),
268         RTEMS.SIGNAL_18 + RTEMS.SIGNAL_19,
269         STATUS
270      );
271      TEST_SUPPORT.DIRECTIVE_FAILED(
272         STATUS,
273         "SIGNAL_SEND - SIGNAL_18 and SIGNAL_19 to TA1"
274      );
275
276      TEXT_IO.PUT_LINE( "TA2 - task_wake_after - yield processor" );
277      RTEMS.TASKS.WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
278      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER YIELD" );
279
280      TEST_SUPPORT.ADA_TEST_END;
281      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
282
283   end TASK_2;
284
285--
286--  PROCESS_ASR
287--
288
289   procedure PROCESS_ASR (
290      THE_SIGNAL_SET : in     RTEMS.SIGNAL_SET
291   ) is
292      STATUS : RTEMS.STATUS_CODES;
293   begin
294
295      TEXT_IO.PUT( "ASR - ENTRY - signal => " );
296      UNSIGNED32_IO.PUT( THE_SIGNAL_SET, BASE => 16, WIDTH => 8 );
297      TEXT_IO.NEW_LINE;
298
299      if THE_SIGNAL_SET = RTEMS.SIGNAL_16 or else
300             THE_SIGNAL_SET = RTEMS.SIGNAL_17 or else
301             THE_SIGNAL_SET = RTEMS.SIGNAL_18 + RTEMS.SIGNAL_19 then
302         NULL;
303
304      elsif THE_SIGNAL_SET = RTEMS.SIGNAL_0 or else
305              THE_SIGNAL_SET = RTEMS.SIGNAL_1 then
306         TEXT_IO.PUT_LINE( "ASR - task_wake_after - yield processor" );
307         RTEMS.TASKS.WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
308         TEST_SUPPORT.DIRECTIVE_FAILED(
309            STATUS,
310            "TASK_WAKE_AFTER YIELD"
311         );
312
313      elsif THE_SIGNAL_SET = RTEMS.SIGNAL_3 then
314
315         SPTEST.ASR_FIRED := TRUE;
316
317      end if;
318
319      TEXT_IO.PUT( "ASR - EXIT  - signal => " );
320      UNSIGNED32_IO.PUT( THE_SIGNAL_SET, BASE => 16, WIDTH => 8 );
321      TEXT_IO.NEW_LINE;
322
323   end PROCESS_ASR;
324     
325end SPTEST;
Note: See TracBrowser for help on using the repository browser.