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

4.104.114.84.95
Last change on this file since 8e7b810 was 8e7b810, checked in by Joel Sherrill <joel.sherrill@…>, on Jun 2, 1997 at 11:47:05 PM

added subtract of 1 to Task_Number to account for the creation
of the initialization task

  • Property mode set to 100644
File size: 4.5 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-1997.
14--  On-Line Applications Research Corporation (OAR).
15--  Copyright assigned to U.S. Government, 1994.
16--
17--  The license and distribution terms for this file may in
18--  the file LICENSE in this distribution or at
19--  http://www.OARcorp.com/rtems/license.html.
20--
21--  $Id$
22--
23
24with Interfaces; use Interfaces;
25with RTEMS;
26with Unsigned32_IO;
27with Status_IO;
28with Text_IO;
29
30package body Test_Support is
31
32--PAGE
33--
34--  Fatal_Directive_Status
35--
36
37   procedure Fatal_Directive_Status (
38      Status  : in     RTEMS.Status_Codes;
39      Desired : in     RTEMS.Status_Codes;
40      Message : in     String
41   ) is
42   begin
43
44      if not RTEMS.Are_Statuses_Equal( Status, Desired ) then
45
46         Text_IO.Put( Message );
47         Text_IO.Put( " FAILED -- expected " );
48         Status_IO.Put( Desired );
49         Text_IO.Put( " got " );
50         Status_IO.Put( Status );
51         Text_IO.New_Line;
52
53         RTEMS.Fatal_Error_Occurred( RTEMS.Status_Codes'Pos( Status ) );
54
55      end if;
56
57   end Fatal_Directive_Status;
58
59--PAGE
60--
61--  Directive_Failed
62--
63
64   procedure Directive_Failed (
65      Status  : in     RTEMS.Status_Codes;
66      Message : in     String
67   ) is
68   begin
69
70      Test_Support.Fatal_Directive_Status(
71         Status, 
72         RTEMS.Successful, 
73         Message
74      );
75
76   end Directive_Failed;
77
78--PAGE
79--
80--  Print_Time
81--
82
83   procedure Print_Time (
84      Prefix      : in     String;
85      Time_Buffer : in     RTEMS.Time_Of_Day;
86      Suffix      : in     String
87   ) is
88   begin
89
90      Text_IO.Put( Prefix );
91      Unsigned32_IO.Put( Time_Buffer.Hour, Width=>2 );
92      Text_IO.Put( ":" );
93      Unsigned32_IO.Put( Time_Buffer.Minute, Width=>2 );
94      Text_IO.Put( ":" );
95      Unsigned32_IO.Put( Time_Buffer.Second, Width=>2 );
96      Text_IO.Put( "   " );
97      Unsigned32_IO.Put( Time_Buffer.Month, Width=>2 );
98      Text_IO.Put( "/" );
99      Unsigned32_IO.Put( Time_Buffer.Day, Width=>2 );
100      Text_IO.Put( "/" );
101      Unsigned32_IO.Put( Time_Buffer.Year, Width=>2 );
102      Text_IO.Put( Suffix );
103
104   end Print_Time;
105
106--PAGE
107--
108--  Put_Dot
109--
110 
111   procedure Put_Dot (
112      Buffer : in     String
113   ) is
114   begin
115      Text_IO.Put( Buffer );
116      Text_IO.FLUSH;
117   end Put_Dot;
118
119--PAGE
120--
121--  Pause
122--
123
124   procedure Pause is
125      Ignored_String : String( 1 .. 80 );
126      Ignored_Last   : Natural;
127     
128   begin
129
130      --
131      --  Really should be a "put" followed by a "flush."
132      --
133      Text_IO.Put_Line( "<pause> " );
134      Text_IO.Get_Line( Ignored_String, Ignored_Last );
135
136   exception
137
138      when Text_IO.End_Error =>
139      -- ignore this error.  It happens when redirecting input from /dev/null
140      return;
141
142   end Pause;
143
144--PAGE
145--
146--  Pause_And_Screen_Number
147--
148 
149   procedure Pause_And_Screen_Number (
150      SCREEN : in    RTEMS.Unsigned32
151   ) is
152      Ignored_String : String( 1 .. 80 );
153      Ignored_Last   : Natural;
154   begin
155 
156      --
157      --  Really should be a "put" followed by a "flush."
158      --
159      Text_IO.Put( "<pause - screen  " );
160      Unsigned32_IO.Put( SCREEN, Width=>2 );
161      Text_IO.Put_Line( "> " );
162      Text_IO.Get_Line( Ignored_String, Ignored_Last );
163 
164   exception
165
166      when Text_IO.End_Error =>
167      -- ignore this error.  It happens when redirecting input from /dev/null
168      return;
169
170   end Pause_And_Screen_Number;
171
172--PAGE
173--
174--  Put_Name
175--
176
177   procedure Put_Name (
178      Name     : in     RTEMS.Name;
179      New_Line : in     Boolean
180   ) is
181      C1 : Character;
182      C2 : Character;
183      C3 : Character;
184      C4 : Character;
185   begin
186
187      RTEMS.Name_To_Characters( Name, C1, C2, C3, C4 );
188
189      Text_IO.Put( C1 );
190      Text_IO.Put( C2 );
191      Text_IO.Put( C3 );
192      Text_IO.Put( C4 );
193
194      if New_Line = True then
195         Text_IO.New_Line;
196      end if;
197
198   end Put_Name;
199 
200--PAGE
201--
202--  Task_Number
203--
204
205   function Task_Number (
206      TID : in     RTEMS.ID
207   ) return RTEMS.Unsigned32 is
208   begin
209
210      return RTEMS.Get_Index( TID ) - 1 -
211        RTEMS.Configuration.RTEMS_API_Configuration.Number_Of_Initialization_Tasks;
212
213   end Task_Number;
214
215--PAGE
216--
217--  Do_Nothing
218--
219
220   procedure Do_Nothing is
221   begin
222      NULL;
223   end Do_Nothing;
224   
225
226--PAGE
227--
228--  Milliseconds_Per_Tick
229--
230
231   function Milliseconds_Per_Tick 
232   return RTEMS.Unsigned32 is
233   begin
234      return RTEMS.Configuration.Microseconds_Per_Tick / 1000;
235   end Milliseconds_Per_Tick;
236end Test_Support;
Note: See TracBrowser for help on using the repository browser.