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

5
Last change on this file since 865b3027 was bc96f3b4, checked in by Sebastian Huber <sebastian.huber@…>, on 01/23/18 at 08:53:06

ada: Introduce RTEMS.Size type

Some time ago the Classic API object size related parameters were
changed to use size_t. Reflect this in the Ada bindings.

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