source: rtems/c/src/ada-tests/sptests/sp20/sptest.adb @ 820901ba

4.104.114.84.95
Last change on this file since 820901ba was 820901ba, checked in by Joel Sherrill <joel.sherrill@…>, on 05/03/05 at 21:41:45

2005-05-03 Joel Sherrill <joel@…>

  • samples/hello/sptest.adb, sptests/sp03/sptest.adb, sptests/sp04/sptest.adb, sptests/sp05/sptest.adb, sptests/sp07/sptest.adb, sptests/sp13/sptest.adb, sptests/sp14/sptest.adb, sptests/sp20/sptest.adb, sptests/sp24/sptest.adb, tmtests/tm01/tmtest.adb, tmtests/tm02/tmtest.adb, tmtests/tm03/tmtest.adb, tmtests/tm04/tmtest.adb, tmtests/tm05/tmtest.adb, tmtests/tm06/tmtest.adb, tmtests/tm07/tmtest.adb, tmtests/tm08/tmtest.adb, tmtests/tm09/tmtest.adb, tmtests/tm10/tmtest.adb, tmtests/tm11/tmtest.adb, tmtests/tm12/tmtest.adb, tmtests/tm13/tmtest.adb, tmtests/tm14/tmtest.adb, tmtests/tm15/tmtest.adb, tmtests/tm16/tmtest.adb, tmtests/tm17/tmtest.adb, tmtests/tm18/tmtest.adb, tmtests/tm19/tmtest.adb, tmtests/tm20/tmtest.adb, tmtests/tm21/tmtest.adb, tmtests/tm22/tmtest.adb, tmtests/tm23/tmtest.adb, tmtests/tm24/tmtest.adb, tmtests/tm25/tmtest.adb, tmtests/tm28/tmtest.adb, tmtests/tm29/tmtest.adb, tmtests/tmck/tmtest.adb, tmtests/tmoverhd/dummy_rtems.adb, tmtests/tmoverhd/tmtest.adb: Remove warnings.
  • Property mode set to 100644
File size: 7.0 KB
Line 
1--
2--  SPTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation of Test 20 of the RTEMS
7--  Single Processor Test Suite.
8--
9--  DEPENDENCIES:
10--
11-- 
12--
13--  COPYRIGHT (c) 1989-1997.
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.com/license/LICENSE.
19--
20--  $Id$
21--
22
23with INTERFACES; use INTERFACES;
24with RTEMS;
25with TEST_SUPPORT;
26with TEXT_IO;
27with UNSIGNED32_IO;
28
29package body SPTEST is
30
31--PAGE
32--
33--  INIT
34--
35
36   procedure INIT (
37      ARGUMENT : in     RTEMS.TASK_ARGUMENT
38   ) is
39      STATUS : RTEMS.STATUS_CODES;
40   begin
41
42      TEXT_IO.NEW_LINE( 2 );
43      TEXT_IO.PUT_LINE( "*** TEST 20 ***" );
44
45      SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'A', '1', ' ' );
46      SPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  'T', 'A', '2', ' ' );
47      SPTEST.TASK_NAME( 3 ) := RTEMS.BUILD_NAME(  'T', 'A', '3', ' ' );
48      SPTEST.TASK_NAME( 4 ) := RTEMS.BUILD_NAME(  'T', 'A', '4', ' ' );
49      SPTEST.TASK_NAME( 5 ) := RTEMS.BUILD_NAME(  'T', 'A', '5', ' ' );
50
51      for INDEX in 1 .. 5
52      loop
53
54         SPTEST.COUNT( INDEX ) := 0;
55
56         RTEMS.TASK_CREATE(
57            SPTEST.TASK_NAME( INDEX ),
58            SPTEST.PRIORITIES( INDEX ),
59            4096,
60            RTEMS.DEFAULT_MODES,
61            RTEMS.DEFAULT_ATTRIBUTES,
62            SPTEST.TASK_ID( INDEX ),
63            STATUS
64         );
65         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE LOOP" );
66
67      end loop;
68
69      for INDEX in 1 .. 5
70      loop
71
72         RTEMS.TASK_START(
73            SPTEST.TASK_ID( INDEX ),
74            SPTEST.TASK_1_THROUGH_5'ACCESS,
75            RTEMS.TASK_ARGUMENT( INDEX ),
76            STATUS
77         );
78         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START LOOP" );
79 
80      end loop;
81
82      RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
83      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
84
85   end INIT;
86
87--PAGE
88--
89--  TASK_1_THROUGH_5
90--
91
92   procedure TASK_1_THROUGH_5 (
93      ARGUMENT : in     RTEMS.TASK_ARGUMENT
94   ) is
95      RMID      : RTEMS.ID;
96      TEST_RMID : RTEMS.ID;
97      PASS      : RTEMS.UNSIGNED32;
98      FAILED    : RTEMS.UNSIGNED32;
99      STATUS    : RTEMS.STATUS_CODES;
100   begin
101
102      RTEMS.RATE_MONOTONIC_CREATE( ARGUMENT, RMID, STATUS );
103      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "RATE_MONOTONIC_CREATE" );
104      TEST_SUPPORT.PUT_NAME( SPTEST.TASK_NAME( INTEGER( ARGUMENT ) ), FALSE );
105      TEXT_IO.PUT( "- rate_monotonic_create id = " );
106      UNSIGNED32_IO.PUT( RMID, WIDTH => 8, BASE => 16 );
107      TEXT_IO.NEW_LINE;
108 
109      RTEMS.RATE_MONOTONIC_IDENT( ARGUMENT, TEST_RMID, STATUS );
110      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "RATE_MONOTONIC_IDENT" );
111      TEST_SUPPORT.PUT_NAME( SPTEST.TASK_NAME( INTEGER( ARGUMENT ) ), FALSE );
112      TEXT_IO.PUT( "- rate_monotonic_ident id = " );
113      UNSIGNED32_IO.PUT( RMID, WIDTH => 8, BASE => 16 );
114      TEXT_IO.NEW_LINE;
115      if TEST_RMID /= RMID then
116         TEXT_IO.PUT_LINE( "RMID's DO NOT MATCH!!!" );
117         RTEMS.SHUTDOWN_EXECUTIVE( 0 );
118      end if;
119
120      TEST_SUPPORT.PUT_NAME( SPTEST.TASK_NAME( INTEGER( ARGUMENT ) ), FALSE );
121      TEXT_IO.PUT( " - (" );
122      UNSIGNED32_IO.PUT( RMID, WIDTH => 1, BASE => 16 );
123      TEXT_IO.PUT( ") period " );
124      UNSIGNED32_IO.PUT(
125         SPTEST.PERIODS( INTEGER( ARGUMENT ) ),
126         WIDTH => 1,
127         BASE => 10
128      );
129      TEXT_IO.NEW_LINE;
130       
131      RTEMS.TASK_WAKE_AFTER( 2, STATUS );
132      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
133   
134      case ARGUMENT is
135         when 1 .. 4 =>
136            loop
137               RTEMS.RATE_MONOTONIC_PERIOD(
138                  RMID,
139                  SPTEST.PERIODS( INTEGER( ARGUMENT ) ),
140                  STATUS
141               );
142
143               TEST_SUPPORT.DIRECTIVE_FAILED(
144                  STATUS,
145                  "RATE_MONOTONIC_PERIOD"
146               );
147
148               SPTEST.COUNT( INTEGER( ARGUMENT ) ) :=
149                  SPTEST.COUNT( INTEGER( ARGUMENT ) ) + 1;
150
151            end loop;
152
153         when 5 =>
154
155            PASS   := 0;
156            FAILED := 0;
157
158            RTEMS.RATE_MONOTONIC_PERIOD(
159               RMID,
160               SPTEST.PERIODS( INTEGER( ARGUMENT ) ),
161               STATUS
162            );
163
164            TEST_SUPPORT.DIRECTIVE_FAILED(
165               STATUS,
166               "RATE_MONOTONIC_PERIOD 1 OF TA5"
167            );
168
169            SPTEST.GET_ALL_COUNTERS;
170
171            loop
172
173               RTEMS.RATE_MONOTONIC_PERIOD(
174                  RMID,
175                  SPTEST.PERIODS( INTEGER( ARGUMENT ) ),
176                  STATUS
177               );
178
179               TEST_SUPPORT.DIRECTIVE_FAILED(
180                  STATUS,
181                  "RATE_MONOTONIC_PERIOD 2 OF TA5"
182               );
183
184               SPTEST.GET_ALL_COUNTERS;
185
186               for INDEX in 1 .. 4
187               loop
188
189                  if SPTEST.TEMPORARY_COUNT( INDEX ) /=
190                        SPTEST.ITERATIONS( INDEX ) then
191
192                     TEXT_IO.PUT( "FAIL -- " );
193                     TEST_SUPPORT.PUT_NAME(
194                        SPTEST.TASK_NAME( INDEX ),
195                        FALSE
196                     );
197                     TEXT_IO.PUT( "ACTUAL=" );
198                     UNSIGNED32_IO.PUT(
199                        SPTEST.TEMPORARY_COUNT( INDEX ),
200                        WIDTH => 3,
201                        BASE => 10
202                     );
203                     TEXT_IO.PUT( " EXPECTED=" );
204                     UNSIGNED32_IO.PUT(
205                        SPTEST.ITERATIONS( INDEX ),
206                        WIDTH => 3,
207                        BASE => 10
208                     );
209                     TEXT_IO.NEW_LINE;
210
211                     FAILED := FAILED + 1;
212
213                  end if;
214
215               end loop;
216
217               if FAILED = 5 then
218                  RTEMS.SHUTDOWN_EXECUTIVE( 0 );
219               end if;
220
221               PASS := PASS + 1;
222               TEXT_IO.PUT( "TA5 - PERIODS CHECK OK (" );
223               UNSIGNED32_IO.PUT( PASS, WIDTH => 1, BASE => 10 );
224               TEXT_IO.PUT_LINE( ")" );
225 
226               if PASS = 10 then
227                  TEXT_IO.PUT_LINE( "*** END OF TEST 20 ***" );
228                  RTEMS.SHUTDOWN_EXECUTIVE( 0 );
229               end if;
230
231            end loop;
232 
233         when others =>
234            NULL;
235           
236      end case;
237
238   end TASK_1_THROUGH_5;
239
240--PAGE
241--
242--  GET_ALL_COUNTERS
243--
244
245   procedure GET_ALL_COUNTERS
246   is
247      PREVIOUS_MODE : RTEMS.MODE;
248      STATUS        : RTEMS.STATUS_CODES;
249   begin
250
251      RTEMS.TASK_MODE(
252         RTEMS.NO_PREEMPT,
253         RTEMS.PREEMPT_MASK,
254         PREVIOUS_MODE,
255         STATUS
256      );
257      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_MODE TO NO_PREEMPT" );
258
259      SPTEST.TEMPORARY_COUNT := SPTEST.COUNT;
260
261      for INDEX in 1 .. 5
262      loop
263
264         SPTEST.COUNT( INDEX ) := 0;
265
266      end loop;
267     
268      RTEMS.TASK_MODE(
269         RTEMS.PREEMPT,
270         RTEMS.PREEMPT_MASK,
271         PREVIOUS_MODE,
272         STATUS
273      );
274      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_MODE TO PREEMPT" );
275
276   end GET_ALL_COUNTERS;
277
278end SPTEST;
Note: See TracBrowser for help on using the repository browser.