source: rtems/testsuites/ada/mptests/mp08/mptest.adb @ ee537ea

5
Last change on this file since ee537ea was ee537ea, checked in by Sebastian Huber <sebastian.huber@…>, on 10/12/17 at 08:00:10

ada-tests: Move to testsuites/ada

This solves a build dependency issue, e.g. building tests before
librtemsbsp.a exists.

Close #3079.

  • Property mode set to 100644
File size: 4.7 KB
Line 
1--
2--  MPTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation for Test 8 of the RTEMS
7--  Multiprocessor 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;
23with RTEMS.OBJECT;
24with RTEMS.SEMAPHORE;
25with RTEMS.TASKS;
26with TEST_SUPPORT;
27with TEXT_IO;
28with UNSIGNED32_IO;
29
30package body MPTEST is
31
32--
33--  INIT
34--
35
36   procedure INIT (
37      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
38   ) is
39      STATUS : RTEMS.STATUS_CODES;
40   begin
41
42      TEXT_IO.NEW_LINE( 2 );
43      TEXT_IO.PUT( "*** TEST 8 -- NODE " );
44      UNSIGNED32_IO.PUT(
45         TEST_SUPPORT.NODE,
46         WIDTH => 1
47      );
48      TEXT_IO.PUT_LINE( " ***" );
49
50      MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  '1', '1', '1', ' ' );
51      MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  '2', '2', '2', ' ' );
52
53      MPTEST.SEMAPHORE_NAME( 1 ) := RTEMS.BUILD_NAME(  'S', 'E', 'M', ' ' );
54
55      if TEST_SUPPORT.NODE = 1 then
56
57         TEXT_IO.PUT_LINE( "Creating Semaphore(Global)" );
58
59         RTEMS.SEMAPHORE.CREATE(
60            MPTEST.SEMAPHORE_NAME( 1 ),
61            1,
62            RTEMS.GLOBAL,
63            MPTEST.SEMAPHORE_ID( 1 ),
64            STATUS
65         );
66         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_CREATE" );
67
68      end if;
69
70      TEXT_IO.PUT_LINE( "Creating Test_task (Global)" );
71      RTEMS.TASKS.CREATE(
72         MPTEST.TASK_NAME( TEST_SUPPORT.NODE ),
73         TEST_SUPPORT.NODE,
74         2048,
75         RTEMS.TIMESLICE,
76         RTEMS.GLOBAL,
77         MPTEST.TASK_ID( 1 ),
78         STATUS
79      );
80      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
81
82      TEXT_IO.PUT_LINE( "Starting Test_task (Global)" );
83      RTEMS.TASKS.START(
84         MPTEST.TASK_ID( 1 ),
85         MPTEST.TEST_TASK'ACCESS,
86         0,
87         STATUS
88      );
89      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
90
91      TEXT_IO.PUT_LINE( "Deleting initialization task" );
92      RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
93      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
94
95   end INIT;
96
97--
98--  TEST_TASK
99--
100
101   procedure TEST_TASK (
102      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
103   ) is
104      DOTS                     : RTEMS.UNSIGNED32;
105      COUNT                    : RTEMS.UNSIGNED32;
106      STATUS                   : RTEMS.STATUS_CODES;
107   begin
108
109      TEXT_IO.PUT_LINE( "Getting SMID of semaphore" );
110      loop
111
112         RTEMS.SEMAPHORE.IDENT(
113            MPTEST.SEMAPHORE_NAME( 1 ),
114            RTEMS.SEARCH_ALL_NODES,
115            MPTEST.SEMAPHORE_ID( 1 ),
116            STATUS
117         );
118
119         exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
120
121      end loop;
122
123      if TEST_SUPPORT.NODE = 2 then
124
125         RTEMS.SEMAPHORE.DELETE(
126            MPTEST.SEMAPHORE_ID( 1 ),
127            STATUS
128         );
129         TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
130            STATUS,
131            RTEMS.ILLEGAL_ON_REMOTE_OBJECT,
132            "SEMAPHORE_DELETE"
133         );
134
135         TEXT_IO.PUT_LINE(
136            "semaphore_delete correctly returned ILLEGAL_ON_REMOTE_OBJECT"
137         );
138
139      end if;
140
141      COUNT := 0;
142
143      loop
144
145         TEST_SUPPORT.PUT_DOT( "p" );
146
147         RTEMS.SEMAPHORE.OBTAIN(
148            MPTEST.SEMAPHORE_ID( 1 ),
149            RTEMS.DEFAULT_OPTIONS,
150            RTEMS.NO_TIMEOUT,
151            STATUS
152         );
153
154         if not RTEMS.IS_STATUS_SUCCESSFUL( STATUS ) then
155
156            TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
157               STATUS,
158               RTEMS.OBJECT_WAS_DELETED,
159               "SEMAPHORE_OBTAIN"
160            );
161
162            TEXT_IO.NEW_LINE;
163
164            TEXT_IO.PUT_LINE( "Global semaphore deleted" );
165
166            TEXT_IO.PUT_LINE( "*** END OF TEST 8 ***" );
167
168            RTEMS.SHUTDOWN_EXECUTIVE( 0 );
169
170         end if;
171
172         COUNT := COUNT + 1;
173
174         if TEST_SUPPORT.NODE = 1 and then
175            COUNT >= 1000 then
176
177            RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
178            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
179
180            TEXT_IO.NEW_LINE;
181
182            TEXT_IO.PUT_LINE( "Deleting global semaphore" );
183
184            RTEMS.SEMAPHORE.DELETE( MPTEST.SEMAPHORE_ID( 1 ), STATUS );
185            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_DELETE" );
186
187            TEXT_IO.PUT_LINE( "*** END OF TEST 8 ***" );
188
189            RTEMS.SHUTDOWN_EXECUTIVE( 0 );
190
191         end if;
192
193         TEST_SUPPORT.PUT_DOT( "v" );
194
195         RTEMS.SEMAPHORE.RELEASE( MPTEST.SEMAPHORE_ID( 1 ), STATUS );
196
197         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE" );
198
199      end loop;
200
201   end TEST_TASK;
202
203end MPTEST;
Note: See TracBrowser for help on using the repository browser.