source: rtems/c/src/ada-tests/mptests/mp04/mptest.adb @ 32c8960

4.115
Last change on this file since 32c8960 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: 3.8 KB
Line 
1--
2--  MPTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation for Test 4 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.TASKS;
24with TEST_SUPPORT;
25with TEXT_IO;
26with UNSIGNED32_IO;
27
28package body MPTEST is
29
30--
31--  INIT
32--
33
34   procedure INIT (
35      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
36   ) is
37      STATUS : RTEMS.STATUS_CODES;
38   begin
39
40      TEXT_IO.NEW_LINE( 2 );
41      TEXT_IO.PUT( "*** TEST 4 -- NODE " );
42      UNSIGNED32_IO.PUT(
43         TEST_SUPPORT.NODE,
44         WIDTH => 1
45      );
46      TEXT_IO.PUT_LINE( " ***" );
47
48      MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  '1', '1', '1', ' ' );
49      MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  '2', '2', '2', ' ' );
50
51      TEXT_IO.PUT_LINE( "Creating Test_task (Global)" );
52
53      RTEMS.TASKS.CREATE(
54         MPTEST.TASK_NAME( TEST_SUPPORT.NODE ),
55         TEST_SUPPORT.NODE,
56         2048,
57         RTEMS.DEFAULT_MODES,
58         RTEMS.GLOBAL,
59         MPTEST.TASK_ID( 1 ),
60         STATUS
61      );
62      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
63
64      TEXT_IO.PUT_LINE( "Starting Test_task (Global)" );
65
66      RTEMS.TASKS.START(
67         MPTEST.TASK_ID( 1 ),
68         MPTEST.TEST_TASK'ACCESS,
69         0,
70         STATUS
71      );
72      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
73
74      TEXT_IO.PUT_LINE( "Deleting initialization task" );
75
76      RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
77      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
78
79   end INIT;
80
81--
82--  TEST_TASK
83--
84
85   procedure TEST_TASK (
86      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
87   ) is
88      TID                 : RTEMS.ID;
89      PREVIOUS_PRIORITY   : RTEMS.TASKS.PRIORITY;
90      PREVIOUS_PRIORITY_1 : RTEMS.TASKS.PRIORITY;
91      STATUS              : RTEMS.STATUS_CODES;
92   begin
93
94      RTEMS.TASKS.IDENT( RTEMS.SELF, RTEMS.SEARCH_ALL_NODES, TID, STATUS );
95      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_IDENT OF SELF" );
96   
97      TEXT_IO.PUT_LINE( "Getting TID of remote task" );
98      if TEST_SUPPORT.NODE = 1 then
99         MPTEST.REMOTE_NODE := 2;
100      else
101         MPTEST.REMOTE_NODE := 1;
102      end if;
103
104      TEXT_IO.PUT( "Remote task's name is : " );
105      TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( MPTEST.REMOTE_NODE ), TRUE );
106
107      loop
108
109         RTEMS.TASKS.IDENT(
110            MPTEST.TASK_NAME( MPTEST.REMOTE_NODE ),
111            RTEMS.SEARCH_ALL_NODES,
112            MPTEST.REMOTE_TID,
113            STATUS
114         );
115
116         exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
117
118      end loop;
119
120      RTEMS.TASKS.SET_PRIORITY(
121         MPTEST.REMOTE_TID,
122         TEST_SUPPORT.NODE,
123         PREVIOUS_PRIORITY,
124         STATUS
125      );
126      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
127
128      if PREVIOUS_PRIORITY /= MPTEST.REMOTE_NODE then
129
130         TEXT_IO.PUT( "Remote priority (0x" );
131         UNSIGNED32_IO.PUT( PREVIOUS_PRIORITY, BASE => 16 );
132         TEXT_IO.PUT( "does not match remote node (0x" );
133         UNSIGNED32_IO.PUT( MPTEST.REMOTE_NODE, BASE => 16 );
134         TEXT_IO.PUT_LINE( ")!!!" );
135
136         RTEMS.SHUTDOWN_EXECUTIVE( 16#F00000# );
137
138      end if;
139
140      loop
141
142         RTEMS.TASKS.SET_PRIORITY(
143            RTEMS.SELF,
144            RTEMS.TASKS.CURRENT_PRIORITY,
145            PREVIOUS_PRIORITY_1,
146            STATUS
147         );
148         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
149
150         exit when PREVIOUS_PRIORITY_1 = MPTEST.REMOTE_NODE;
151
152      end loop;
153
154
155      TEXT_IO.PUT_LINE( "Local task priority has been set" );
156
157      TEXT_IO.PUT_LINE( "*** END OF TEST 4 ***" );
158
159      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
160
161   end TEST_TASK;
162
163end MPTEST;
Note: See TracBrowser for help on using the repository browser.