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

Last change on this file was 3d8f2a55, checked in by Joel Sherrill <joel@…>, on 04/06/22 at 21:37:41

testsuites/ada/sptests/sp1*: Change license to BSD-2

Updates #3053.

  • Property mode set to 100644
File size: 9.9 KB
Line 
1-- SPDX-License-Identifier: BSD-2-Clause
2
3--
4--  SPTEST / BODY
5--
6--  DESCRIPTION:
7--
8--  This package is the implementation of Test 14 of the RTEMS
9--  Single Processor Test Suite.
10--
11--  DEPENDENCIES:
12--
13-- 
14--
15--  COPYRIGHT (c) 1989-2011.
16--  On-Line Applications Research Corporation (OAR).
17--
18--  Redistribution and use in source and binary forms, with or without
19--  modification, are permitted provided that the following conditions
20--  are met:
21--  1. Redistributions of source code must retain the above copyright
22--     notice, this list of conditions and the following disclaimer.
23--  2. Redistributions in binary form must reproduce the above copyright
24--     notice, this list of conditions and the following disclaimer in the
25--     documentation and/or other materials provided with the distribution.
26--
27--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
28--  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
29--  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
30--  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
31--  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
32--  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
33--  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
34--  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
35--  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36--  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
37--  POSSIBILITY OF SUCH DAMAGE.
38--
39
40with ADDRESS_IO;
41with TEST_SUPPORT;
42with TEXT_IO;
43with UNSIGNED32_IO;
44with INTERFACES; use INTERFACES;
45with RTEMS.TIMER;
46with RTEMS.SIGNAL;
47with Interfaces.C;
48use Interfaces.C;
49
50package body SPTEST is
51
52--
53--  INIT
54--
55
56   procedure INIT (
57      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
58   ) is
59      pragma Unreferenced(ARGUMENT);
60      STATUS : RTEMS.STATUS_CODES;
61   begin
62
63      TEXT_IO.NEW_LINE( 2 );
64      TEST_SUPPORT.ADA_TEST_BEGIN;
65
66      SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'A', '1', ' ' );
67      SPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  'T', 'A', '2', ' ' );
68
69      RTEMS.TASKS.CREATE(
70         SPTEST.TASK_NAME( 1 ),
71         1,
72         RTEMS.MINIMUM_STACK_SIZE * 2,
73         RTEMS.DEFAULT_MODES,
74         RTEMS.DEFAULT_ATTRIBUTES,
75         SPTEST.TASK_ID( 1 ),
76         STATUS
77      );
78      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
79
80      RTEMS.TASKS.CREATE(
81         SPTEST.TASK_NAME( 2 ),
82         1,
83         RTEMS.MINIMUM_STACK_SIZE * 2,
84         RTEMS.DEFAULT_MODES,
85         RTEMS.DEFAULT_ATTRIBUTES,
86         SPTEST.TASK_ID( 2 ),
87         STATUS
88      );
89      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA2" );
90
91      RTEMS.TASKS.START(
92         SPTEST.TASK_ID( 1 ),
93         SPTEST.TASK_1'ACCESS,
94         0,
95         STATUS
96      );
97      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
98
99      RTEMS.TASKS.START(
100         SPTEST.TASK_ID( 2 ),
101         SPTEST.TASK_2'ACCESS,
102         0,
103         STATUS
104      );
105      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA2" );
106
107      SPTEST.TIMER_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'M', '1', ' ' );
108
109      RTEMS.TIMER.CREATE(
110         SPTEST.TIMER_NAME( 1 ),
111         SPTEST.TIMER_ID( 1 ),
112         STATUS
113      );
114      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM1" );
115
116      RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
117      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
118
119   end INIT;
120
121--
122--  SIGNAL_3_TO_TASK_1
123--
124
125   procedure SIGNAL_3_TO_TASK_1 (
126      ID      : in     RTEMS.ID;
127      POINTER : in     RTEMS.ADDRESS
128   ) is
129      STATUS : RTEMS.STATUS_CODES;
130   begin
131
132      RTEMS.SIGNAL.SEND( SPTEST.TASK_ID( 1 ), RTEMS.SIGNAL_3, STATUS );
133      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SIGNAL_SEND of 3" );
134
135      SPTEST.TIMER_GOT_THIS_ID      := ID;
136      SPTEST.TIMER_GOT_THIS_POINTER := POINTER;
137
138      SPTEST.SIGNAL_SENT := TRUE;
139
140   end SIGNAL_3_TO_TASK_1;
141
142--
143--  TASK_1
144--
145
146   procedure TASK_1 (
147      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
148   ) is
149      pragma Unreferenced(ARGUMENT);
150      PREVIOUS_MODE : RTEMS.MODE;
151      STATUS        : RTEMS.STATUS_CODES;
152   begin
153
154      TEXT_IO.PUT_LINE( "TA1 - signal_catch - INTERRUPT_LEVEL( 3 )" );
155      RTEMS.SIGNAL.CATCH(
156         SPTEST.PROCESS_ASR'ACCESS,
157         RTEMS.INTERRUPT_LEVEL( 3 ),
158         STATUS
159      );
160      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SIGNAL_CATCH INTERRUPT(3)" );
161   
162      TEXT_IO.PUT_LINE( "TA1 - signal_send - SIGNAL_16 to self" );
163      RTEMS.SIGNAL.SEND( RTEMS.SELF, RTEMS.SIGNAL_16, STATUS );
164      TEST_SUPPORT.DIRECTIVE_FAILED(
165         STATUS,
166         "SIGNAL_SEND - SIGNAL_16 to SELF"
167      );
168
169      TEXT_IO.PUT_LINE( "TA1 - signal_send - SIGNAL_0 to self" );
170      RTEMS.SIGNAL.SEND( RTEMS.SELF, RTEMS.SIGNAL_0, STATUS );
171      TEST_SUPPORT.DIRECTIVE_FAILED(
172         STATUS,
173         "SIGNAL_SEND - SIGNAL_0 to SELF"
174      );
175
176      TEXT_IO.PUT_LINE( "TA1 - signal_catch - NO_ASR" );
177      RTEMS.SIGNAL.CATCH(SPTEST.PROCESS_ASR'ACCESS, RTEMS.NO_ASR, STATUS);
178      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SIGNAL_CATCH - NO_ASR" );
179
180      TEST_SUPPORT.PAUSE;
181
182      TEXT_IO.PUT_LINE( "TA1 - signal_send - SIGNAL_1 to self" );
183      RTEMS.SIGNAL.SEND( RTEMS.SELF, RTEMS.SIGNAL_1, STATUS );
184      TEST_SUPPORT.DIRECTIVE_FAILED(
185         STATUS,
186         "SIGNAL_SEND - SIGNAL_1 to SELF"
187      );
188
189      TEXT_IO.PUT_LINE( "TA1 - task_mode - disable ASRs" );
190      RTEMS.TASKS.MODE(
191         RTEMS.NO_ASR,
192         RTEMS.ASR_MASK,
193         PREVIOUS_MODE,
194         STATUS
195      );
196      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_MODE" );
197
198      SPTEST.TIMER_GOT_THIS_ID := 0;
199      SPTEST.TIMER_GOT_THIS_POINTER := RTEMS.NULL_ADDRESS;
200
201      TEXT_IO.PUT_LINE( "TA1 - sending signal to SELF from timer" );
202      RTEMS.TIMER.FIRE_AFTER(
203         SPTEST.TIMER_ID( 1 ),
204         TEST_SUPPORT.TICKS_PER_SECOND / 2,
205         SPTEST.SIGNAL_3_TO_TASK_1'ACCESS,
206         SPTEST.TASK_1'ADDRESS,
207         STATUS
208      );
209      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER" );
210
211      TEXT_IO.PUT_LINE( "TA1 - waiting for signal to arrive" );
212
213      SPTEST.SIGNAL_SENT := FALSE;
214      SPTEST.ASR_FIRED   := FALSE;
215
216      loop
217         exit when SPTEST.SIGNAL_SENT;
218      end loop;
219
220      if SPTEST.TIMER_GOT_THIS_ID = SPTEST.TIMER_ID( 1 ) and then
221         RTEMS.ARE_EQUAL(SPTEST.TIMER_GOT_THIS_POINTER,
222             SPTEST.TASK_1'ADDRESS) then
223 
224         TEXT_IO.PUT_LINE( "TA1 - timer routine got the correct arguments" );
225
226      else
227
228         TEXT_IO.PUT( "TA1 - timer got (" );
229         UNSIGNED32_IO.PUT( SPTEST.TIMER_GOT_THIS_ID  );
230         TEXT_IO.PUT( "," );
231         ADDRESS_IO.PUT( SPTEST.TIMER_GOT_THIS_POINTER  );
232         TEXT_IO.PUT( ") instead of (" );
233         UNSIGNED32_IO.PUT( SPTEST.TIMER_ID( 1 ) );
234         TEXT_IO.PUT( "," );
235         ADDRESS_IO.PUT( SPTEST.TASK_1'ADDRESS  );
236         TEXT_IO.PUT_LINE( ")!!!!" );
237
238      end if;
239
240      TEXT_IO.PUT_LINE( "TA1 - task_mode - enable ASRs" );
241      RTEMS.TASKS.MODE(
242         RTEMS.ASR,
243         RTEMS.ASR_MASK,
244         PREVIOUS_MODE,
245         STATUS
246      );
247      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_MODE" );
248
249      TEXT_IO.PUT_LINE( "TA1 - signal_catch - ASR ADDRESS of NULL" );
250      RTEMS.SIGNAL.CATCH( NULL, RTEMS.DEFAULT_MODES, STATUS );
251      TEST_SUPPORT.DIRECTIVE_FAILED(
252         STATUS,
253         "SIGNAL_CATCH - NULL ADDRESS"
254      );
255   
256      TEXT_IO.PUT_LINE( "TA1 - task_delete - delete self" );
257      RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
258      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
259
260   end TASK_1;
261
262--
263--  TASK_2
264--
265
266   procedure TASK_2 (
267      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
268   ) is
269      pragma Unreferenced(ARGUMENT);
270      STATUS : RTEMS.STATUS_CODES;
271   begin
272
273      TEXT_IO.PUT_LINE( "TA2 - signal_send - SIGNAL_17 to TA1" );
274      RTEMS.SIGNAL.SEND( SPTEST.TASK_ID( 1 ), RTEMS.SIGNAL_17, STATUS );
275      TEST_SUPPORT.DIRECTIVE_FAILED(
276         STATUS,
277         "SIGNAL_SEND - SIGNAL_17 to TA1"
278      );
279
280      TEXT_IO.PUT_LINE( "TA2 - task_wake_after - yield processor" );
281      RTEMS.TASKS.WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
282      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER YIELD" );
283
284      TEXT_IO.PUT_LINE(
285         "TA2 - signal_send - SIGNAL_18 and SIGNAL_19 to TA1"
286      );
287      RTEMS.SIGNAL.SEND(
288         SPTEST.TASK_ID( 1 ),
289         RTEMS.SIGNAL_18 + RTEMS.SIGNAL_19,
290         STATUS
291      );
292      TEST_SUPPORT.DIRECTIVE_FAILED(
293         STATUS,
294         "SIGNAL_SEND - SIGNAL_18 and SIGNAL_19 to TA1"
295      );
296
297      TEXT_IO.PUT_LINE( "TA2 - task_wake_after - yield processor" );
298      RTEMS.TASKS.WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
299      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER YIELD" );
300
301      TEST_SUPPORT.ADA_TEST_END;
302      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
303
304   end TASK_2;
305
306--
307--  PROCESS_ASR
308--
309
310   procedure PROCESS_ASR (
311      THE_SIGNAL_SET : in     RTEMS.SIGNAL_SET
312   ) is
313      STATUS : RTEMS.STATUS_CODES;
314   begin
315
316      TEXT_IO.PUT( "ASR - ENTRY - signal => " );
317      UNSIGNED32_IO.PUT( THE_SIGNAL_SET, BASE => 16, WIDTH => 8 );
318      TEXT_IO.NEW_LINE;
319
320      if THE_SIGNAL_SET = RTEMS.SIGNAL_16 or else
321             THE_SIGNAL_SET = RTEMS.SIGNAL_17 or else
322             THE_SIGNAL_SET = RTEMS.SIGNAL_18 + RTEMS.SIGNAL_19 then
323         NULL;
324
325      elsif THE_SIGNAL_SET = RTEMS.SIGNAL_0 or else
326              THE_SIGNAL_SET = RTEMS.SIGNAL_1 then
327         TEXT_IO.PUT_LINE( "ASR - task_wake_after - yield processor" );
328         RTEMS.TASKS.WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
329         TEST_SUPPORT.DIRECTIVE_FAILED(
330            STATUS,
331            "TASK_WAKE_AFTER YIELD"
332         );
333
334      elsif THE_SIGNAL_SET = RTEMS.SIGNAL_3 then
335
336         SPTEST.ASR_FIRED := TRUE;
337
338      end if;
339
340      TEXT_IO.PUT( "ASR - EXIT  - signal => " );
341      UNSIGNED32_IO.PUT( THE_SIGNAL_SET, BASE => 16, WIDTH => 8 );
342      TEXT_IO.NEW_LINE;
343
344   end PROCESS_ASR;
345     
346end SPTEST;
Note: See TracBrowser for help on using the repository browser.