source: rtems/testsuites/ada/support/test_support.adb @ bc96f3b4

Last change on this file since bc96f3b4 was bc96f3b4, checked in by Sebastian Huber <sebastian.huber@…>, on Jan 23, 2018 at 8:53:06 AM

ada: Introduce RTEMS.Size type

Some time ago the Classic API object size related parameters were
changed to use size_t. Reflect this in the Ada bindings.

Update #3082.

  • Property mode set to 100644
File size: 5.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-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 Unsigned32_IO;
23with Status_IO;
24with Text_IO;
25with RTEMS.Fatal;
26
27package body Test_Support is
28
29--
30--  Fatal_Directive_Status
31--
32
33   procedure Fatal_Directive_Status (
34      Status  : in     RTEMS.Status_Codes;
35      Desired : in     RTEMS.Status_Codes;
36      Message : in     String
37   ) is
38   begin
39
40      if not RTEMS.Are_Statuses_Equal( Status, Desired ) then
41
42         Text_IO.Put( Message );
43         Text_IO.Put( " FAILED -- expected " );
44         Status_IO.Put( Desired );
45         Text_IO.Put( " got " );
46         Status_IO.Put( Status );
47         Text_IO.New_Line;
48
49         RTEMS.Fatal.Error_Occurred( RTEMS.Status_Codes'Pos( Status ) );
50
51      end if;
52
53   end Fatal_Directive_Status;
54
55--
56--  Directive_Failed
57--
58
59   procedure Directive_Failed (
60      Status  : in     RTEMS.Status_Codes;
61      Message : in     String
62   ) is
63   begin
64
65      Test_Support.Fatal_Directive_Status(
66         Status, 
67         RTEMS.Successful, 
68         Message
69      );
70
71   end Directive_Failed;
72
73--
74--  Print_Time
75--
76
77   procedure Print_Time (
78      Prefix      : in     String;
79      Time_Buffer : in     RTEMS.Time_Of_Day;
80      Suffix      : in     String
81   ) is
82   begin
83
84      Text_IO.Put( Prefix );
85      Unsigned32_IO.Put( Time_Buffer.Hour, Width=>2 );
86      Text_IO.Put( ":" );
87      Unsigned32_IO.Put( Time_Buffer.Minute, Width=>2 );
88      Text_IO.Put( ":" );
89      Unsigned32_IO.Put( Time_Buffer.Second, Width=>2 );
90      Text_IO.Put( "   " );
91      Unsigned32_IO.Put( Time_Buffer.Month, Width=>2 );
92      Text_IO.Put( "/" );
93      Unsigned32_IO.Put( Time_Buffer.Day, Width=>2 );
94      Text_IO.Put( "/" );
95      Unsigned32_IO.Put( Time_Buffer.Year, Width=>2 );
96      Text_IO.Put( Suffix );
97
98   end Print_Time;
99
100--
101--  Put_Dot
102--
103 
104   procedure Put_Dot (
105      Buffer : in     String
106   ) is
107   begin
108      Text_IO.Put( Buffer );
109      Text_IO.FLUSH;
110   end Put_Dot;
111
112--
113--  Pause
114--
115
116   procedure Pause is
117      --  Ignored_String : String( 1 .. 80 );
118      --  Ignored_Last   : Natural;
119     
120   begin
121
122      --
123      --  Really should be a "put" followed by a "flush."
124      --
125      Text_IO.Put_Line( "<pause> " );
126      -- Text_IO.Get_Line( Ignored_String, Ignored_Last );
127
128   end Pause;
129
130--
131--  Pause_And_Screen_Number
132--
133 
134   procedure Pause_And_Screen_Number (
135      SCREEN : in    RTEMS.Unsigned32
136   ) is
137      --  Ignored_String : String( 1 .. 80 );
138      --  Ignored_Last   : Natural;
139   begin
140 
141      --
142      --  Really should be a "put" followed by a "flush."
143      --
144      Text_IO.Put( "<pause - screen  " );
145      Unsigned32_IO.Put( SCREEN, Width=>2 );
146      Text_IO.Put_Line( "> " );
147   --    Text_IO.Get_Line( Ignored_String, Ignored_Last );
148 
149   end Pause_And_Screen_Number;
150
151--
152--  Put_Name
153--
154
155   procedure Put_Name (
156      Name     : in     RTEMS.Name;
157      New_Line : in     Boolean
158   ) is
159      C1 : Character;
160      C2 : Character;
161      C3 : Character;
162      C4 : Character;
163   begin
164
165      RTEMS.Name_To_Characters( Name, C1, C2, C3, C4 );
166
167      Text_IO.Put( C1 );
168      Text_IO.Put( C2 );
169      Text_IO.Put( C3 );
170      Text_IO.Put( C4 );
171
172      if New_Line then
173         Text_IO.New_Line;
174      end if;
175
176   end Put_Name;
177 
178--
179--  Task_Number
180--
181
182   function Task_Number (
183      TID : in     RTEMS.ID
184   ) return RTEMS.Unsigned32 is
185   begin
186
187      -- probably OK
188      return RTEMS.Get_Index( TID ) - 1;
189
190   end Task_Number;
191
192--
193--  Do_Nothing
194--
195
196   procedure Do_Nothing is
197   begin
198      NULL;
199   end Do_Nothing;
200   
201
202--
203--  Milliseconds_Per_Tick
204--
205
206   function Milliseconds_Per_Tick 
207   return RTEMS.Unsigned32 is
208      function Milliseconds_Per_Tick_Base return RTEMS.Unsigned32;
209      pragma Import (C, Milliseconds_Per_Tick_Base, "milliseconds_per_tick");
210   begin
211      return Milliseconds_Per_Tick_Base;
212   end Milliseconds_Per_Tick;
213
214--
215--  Milliseconds_Per_Tick
216--
217   function Ticks_Per_Second 
218   return RTEMS.Interval is
219      function Ticks_Per_Second_Base return RTEMS.Unsigned32;
220      pragma Import (C, Ticks_Per_Second_Base, "ticks_per_second");
221   begin
222      return Ticks_Per_Second_Base;
223   end Ticks_Per_Second; 
224
225--
226--  Return the size of the RTEMS Workspace
227--
228
229   function Work_Space_Size
230   return RTEMS.Size is
231      function Work_Space_Size_Base return RTEMS.Size;
232      pragma Import (C, Work_Space_Size_Base, "work_space_size");
233   begin
234      return Work_Space_Size_Base;
235   end Work_Space_Size;
236
237--
238--  Return an indication of whether multiprocessing is configured
239--
240
241   function Is_Configured_Multiprocessing
242   return Boolean is
243      function Is_Configured_Multiprocessing_Base return RTEMS.Unsigned32;
244      pragma Import (
245         C, Is_Configured_Multiprocessing_Base, "is_configured_multiprocessing"
246      );
247   begin
248      if Is_Configured_Multiprocessing_Base = 1 then
249         return True;
250      else
251         return False;
252      end if;
253   end Is_Configured_Multiprocessing;
254
255--
256--  Node is the node number in a multiprocessor configuration
257--
258
259   function Node 
260   return RTEMS.Unsigned32 is
261      function Get_Node_Base return RTEMS.Unsigned32;
262      pragma Import (C, Get_Node_Base, "get_node");
263   begin
264      return Get_Node_Base;
265   end Node;
266end Test_Support;
Note: See TracBrowser for help on using the repository browser.