source: rtems/c/src/ada-tests/support/test_support.adb @ a8e724d6

4.104.115
Last change on this file since a8e724d6 was ba3e1a4f, checked in by Glenn Humphrey <glenn.humphrey@…>, on Oct 10, 2007 at 8:58:48 PM

2007-10-10 Glenn Humphrey <glenn.humphrey@…>

  • configure.ac, samples/base_sp/base_sp.scn, samples/base_sp/config.h, samples/base_sp/sptest.adb, samples/hello/config.h, samples/ticker/config.h, samples/ticker/ticker.scn, sptests/Makefile.am, sptests/sp01/sp01.scn, sptests/sp02/config.h, sptests/sp02/sp02.scn, sptests/sp03/config.h, sptests/sp03/sp03.scn, sptests/sp04/sp04.scn, sptests/sp04/sptest.adb, sptests/sp05/config.h, sptests/sp05/sp05.scn, sptests/sp06/config.h, sptests/sp07/config.h, sptests/sp07/sp07.scn, sptests/sp07/sptest.adb, sptests/sp07/sptest.ads, sptests/sp08/config.h, sptests/sp08/sp08.scn, sptests/sp09/Makefile.am, sptests/sp09/config.h, sptests/sp09/sp09.scn, sptests/sp09/sptest.adb, sptests/sp09/sptest.ads, sptests/sp11/config.h, sptests/sp11/sp11.scn, sptests/sp12/config.h, sptests/sp12/sp12.scn, sptests/sp13/config.h, sptests/sp13/sp13.scn, sptests/sp13/sptest.adb, sptests/sp14/config.h, sptests/sp14/sp14.scn, sptests/sp15/config.h, sptests/sp15/sp15.scn, sptests/sp16/config.h, sptests/sp16/sp16.scn, sptests/sp16/sptest.adb, sptests/sp17/config.h, sptests/sp19/config.h, sptests/sp19/sp19.scn, sptests/sp20/config.h, sptests/sp20/sp20.scn, sptests/sp22/config.h, sptests/sp22/sp22.scn, sptests/sp23/config.h, sptests/sp23/sp23.scn, sptests/sp24/config.h, sptests/sp24/sp24.scn, sptests/sp25/config.h, sptests/sp25/sp25.scn, support/init.c, support/test_support.adb, support/test_support.ads, tmtests/tm09/config.h, tmtests/tm20/tmtest.adb, tmtests/tmoverhd/dummy_rtems.adb, tmtests/tmoverhd/dummy_rtems.ads, tmtests/tmoverhd/tmtest.adb, tmtests/tmoverhd/tmtest.ads: Updated tests so that they would all compile and run without errors. Some tests that are no longer valid using the current binding were removed. Also updated the .scn files to reflect the current test output.
  • sptests/sp21/.cvsignore, sptests/sp21/Makefile.am, sptests/sp21/config.h, sptests/sp21/sp21.adb, sptests/sp21/sp21.scn, sptests/sp21/sptest.adb, sptests/sp21/sptest.ads, sptests/spsize/.cvsignore, sptests/spsize/Makefile.am, sptests/spsize/spsize.adb, sptests/spsize/sptest.adb, sptests/spsize/sptest.ads: Removed.
  • Property mode set to 100644
File size: 6.0 KB
Line 
1--
2--  Test_Support / Specification
3--
4--  DESCRIPTION:
5--
6--  This package provides routines which aid the Test Suites
7--  and simplify their design and operation.
8--
9--  DEPENDENCIES:
10--
11-- 
12--
13--  COPYRIGHT (c) 1989-2007.
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 Unsigned32_IO;
26with Status_IO;
27with Text_IO;
28
29package body Test_Support is
30
31--PAGE
32--
33--  Fatal_Directive_Status
34--
35
36   procedure Fatal_Directive_Status (
37      Status  : in     RTEMS.Status_Codes;
38      Desired : in     RTEMS.Status_Codes;
39      Message : in     String
40   ) is
41   begin
42
43      if not RTEMS.Are_Statuses_Equal( Status, Desired ) then
44
45         Text_IO.Put( Message );
46         Text_IO.Put( " FAILED -- expected " );
47         Status_IO.Put( Desired );
48         Text_IO.Put( " got " );
49         Status_IO.Put( Status );
50         Text_IO.New_Line;
51
52         RTEMS.Fatal_Error_Occurred( RTEMS.Status_Codes'Pos( Status ) );
53
54      end if;
55
56   end Fatal_Directive_Status;
57
58--PAGE
59--
60--  Directive_Failed
61--
62
63   procedure Directive_Failed (
64      Status  : in     RTEMS.Status_Codes;
65      Message : in     String
66   ) is
67   begin
68
69      Test_Support.Fatal_Directive_Status(
70         Status, 
71         RTEMS.Successful, 
72         Message
73      );
74
75   end Directive_Failed;
76
77--PAGE
78--
79--  Print_Time
80--
81
82   procedure Print_Time (
83      Prefix      : in     String;
84      Time_Buffer : in     RTEMS.Time_Of_Day;
85      Suffix      : in     String
86   ) is
87   begin
88
89      Text_IO.Put( Prefix );
90      Unsigned32_IO.Put( Time_Buffer.Hour, Width=>2 );
91      Text_IO.Put( ":" );
92      Unsigned32_IO.Put( Time_Buffer.Minute, Width=>2 );
93      Text_IO.Put( ":" );
94      Unsigned32_IO.Put( Time_Buffer.Second, Width=>2 );
95      Text_IO.Put( "   " );
96      Unsigned32_IO.Put( Time_Buffer.Month, Width=>2 );
97      Text_IO.Put( "/" );
98      Unsigned32_IO.Put( Time_Buffer.Day, Width=>2 );
99      Text_IO.Put( "/" );
100      Unsigned32_IO.Put( Time_Buffer.Year, Width=>2 );
101      Text_IO.Put( Suffix );
102
103   end Print_Time;
104
105--PAGE
106--
107--  Put_Dot
108--
109 
110   procedure Put_Dot (
111      Buffer : in     String
112   ) is
113   begin
114      Text_IO.Put( Buffer );
115      Text_IO.FLUSH;
116   end Put_Dot;
117
118--PAGE
119--
120--  Pause
121--
122
123   procedure Pause is
124      --  Ignored_String : String( 1 .. 80 );
125      --  Ignored_Last   : Natural;
126     
127   begin
128
129      --
130      --  Really should be a "put" followed by a "flush."
131      --
132      Text_IO.Put_Line( "<pause> " );
133      -- Text_IO.Get_Line( Ignored_String, Ignored_Last );
134
135   -- exception
136
137   --    when Text_IO.End_Error =>
138   --    -- ignore this error.  It happens when redirecting input from /dev/null
139   --    return;
140
141   end Pause;
142
143--PAGE
144--
145--  Pause_And_Screen_Number
146--
147 
148   procedure Pause_And_Screen_Number (
149      SCREEN : in    RTEMS.Unsigned32
150   ) is
151      --  Ignored_String : String( 1 .. 80 );
152      --  Ignored_Last   : Natural;
153   begin
154 
155      --
156      --  Really should be a "put" followed by a "flush."
157      --
158      Text_IO.Put( "<pause - screen  " );
159      Unsigned32_IO.Put( SCREEN, Width=>2 );
160      Text_IO.Put_Line( "> " );
161   --    Text_IO.Get_Line( Ignored_String, Ignored_Last );
162 
163   -- exception
164
165   --    when Text_IO.End_Error =>
166   --    -- ignore this error.  It happens when redirecting input from /dev/null
167   --    return;
168
169   end Pause_And_Screen_Number;
170
171--PAGE
172--
173--  Put_Name
174--
175
176   procedure Put_Name (
177      Name     : in     RTEMS.Name;
178      New_Line : in     Boolean
179   ) is
180      C1 : Character;
181      C2 : Character;
182      C3 : Character;
183      C4 : Character;
184   begin
185
186      RTEMS.Name_To_Characters( Name, C1, C2, C3, C4 );
187
188      Text_IO.Put( C1 );
189      Text_IO.Put( C2 );
190      Text_IO.Put( C3 );
191      Text_IO.Put( C4 );
192
193      if New_Line = True then
194         Text_IO.New_Line;
195      end if;
196
197   end Put_Name;
198 
199--PAGE
200--
201--  Task_Number
202--
203
204   function Task_Number (
205      TID : in     RTEMS.ID
206   ) return RTEMS.Unsigned32 is
207   begin
208
209      -- probably OK
210      return RTEMS.Get_Index( TID ) - 1;
211      --   Ignoring this component.
212      --   - RTEMS.Configuration.RTEMS_API_Configuration.Number_Of_Initialization_Tasks;
213
214   end Task_Number;
215
216--PAGE
217--
218--  Do_Nothing
219--
220
221   procedure Do_Nothing is
222   begin
223      NULL;
224   end Do_Nothing;
225   
226
227--PAGE
228--
229--  Milliseconds_Per_Tick
230--
231
232   function Milliseconds_Per_Tick 
233   return RTEMS.Unsigned32 is
234      function Milliseconds_Per_Tick_Base return RTEMS.Unsigned32;
235      pragma Import (C, Milliseconds_Per_Tick_Base, "milliseconds_per_tick");
236   begin
237      return Milliseconds_Per_Tick_Base;
238   end Milliseconds_Per_Tick;
239
240--PAGE
241--
242--  Milliseconds_Per_Tick
243--
244   function Ticks_Per_Second 
245   return RTEMS.Interval is
246      function Ticks_Per_Second_Base return RTEMS.Unsigned32;
247      pragma Import (C, Ticks_Per_Second_Base, "ticks_per_second");
248   begin
249      return Ticks_Per_Second_Base;
250   end Ticks_Per_Second; 
251
252--
253--  Return the size of the RTEMS Workspace
254--
255
256   function Work_Space_Size
257   return RTEMS.Unsigned32 is 
258      function Work_Space_Size_Base return RTEMS.Unsigned32;
259      pragma Import (C, Work_Space_Size_Base, "work_space_size");
260   begin
261      return Work_Space_Size_Base;
262   end Work_Space_Size;
263
264--
265--  Return an indication of whether multiprocessing is configured
266--
267
268   function Is_Configured_Multiprocessing
269   return Boolean is
270      function Is_Configured_Multiprocessing_Base return RTEMS.Unsigned32;
271      pragma Import (
272         C, Is_Configured_Multiprocessing_Base, "is_configured_multiprocessing"
273      );
274   begin
275      if Is_Configured_Multiprocessing_Base = 1 then
276         return True;
277      else
278         return False;
279      end if;
280   end Is_Configured_Multiprocessing;
281
282--
283--  Node is the node number in a multiprocessor configuration
284--
285
286   function Node 
287   return RTEMS.Unsigned32 is
288      function Get_Node_Base return RTEMS.Unsigned32;
289      pragma Import (C, Get_Node_Base, "get_node");
290   begin
291      return Get_Node_Base;
292   end Node;
293end Test_Support;
Note: See TracBrowser for help on using the repository browser.