diff options
Diffstat (limited to 'testsuites/ada/support/test_support.adb')
| -rw-r--r-- | testsuites/ada/support/test_support.adb | 266 |
1 files changed, 266 insertions, 0 deletions
diff --git a/testsuites/ada/support/test_support.adb b/testsuites/ada/support/test_support.adb new file mode 100644 index 0000000000..bc636cee11 --- /dev/null +++ b/testsuites/ada/support/test_support.adb @@ -0,0 +1,266 @@ +-- +-- Test_Support / Specification +-- +-- DESCRIPTION: +-- +-- This package provides routines which aid the Test Suites +-- and simplify their design and operation. +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1989-2011. +-- On-Line Applications Research Corporation (OAR). +-- +-- The license and distribution terms for this file may in +-- the file LICENSE in this distribution or at +-- http://www.rtems.org/license/LICENSE. +-- + +with Interfaces; use Interfaces; +with Unsigned32_IO; +with Status_IO; +with Text_IO; +with RTEMS.Fatal; + +package body Test_Support is + +-- +-- Fatal_Directive_Status +-- + + procedure Fatal_Directive_Status ( + Status : in RTEMS.Status_Codes; + Desired : in RTEMS.Status_Codes; + Message : in String + ) is + begin + + if not RTEMS.Are_Statuses_Equal( Status, Desired ) then + + Text_IO.Put( Message ); + Text_IO.Put( " FAILED -- expected " ); + Status_IO.Put( Desired ); + Text_IO.Put( " got " ); + Status_IO.Put( Status ); + Text_IO.New_Line; + + RTEMS.Fatal.Error_Occurred( RTEMS.Status_Codes'Pos( Status ) ); + + end if; + + end Fatal_Directive_Status; + +-- +-- Directive_Failed +-- + + procedure Directive_Failed ( + Status : in RTEMS.Status_Codes; + Message : in String + ) is + begin + + Test_Support.Fatal_Directive_Status( + Status, + RTEMS.Successful, + Message + ); + + end Directive_Failed; + +-- +-- Print_Time +-- + + procedure Print_Time ( + Prefix : in String; + Time_Buffer : in RTEMS.Time_Of_Day; + Suffix : in String + ) is + begin + + Text_IO.Put( Prefix ); + Unsigned32_IO.Put( Time_Buffer.Hour, Width=>2 ); + Text_IO.Put( ":" ); + Unsigned32_IO.Put( Time_Buffer.Minute, Width=>2 ); + Text_IO.Put( ":" ); + Unsigned32_IO.Put( Time_Buffer.Second, Width=>2 ); + Text_IO.Put( " " ); + Unsigned32_IO.Put( Time_Buffer.Month, Width=>2 ); + Text_IO.Put( "/" ); + Unsigned32_IO.Put( Time_Buffer.Day, Width=>2 ); + Text_IO.Put( "/" ); + Unsigned32_IO.Put( Time_Buffer.Year, Width=>2 ); + Text_IO.Put( Suffix ); + + end Print_Time; + +-- +-- Put_Dot +-- + + procedure Put_Dot ( + Buffer : in String + ) is + begin + Text_IO.Put( Buffer ); + Text_IO.FLUSH; + end Put_Dot; + +-- +-- Pause +-- + + procedure Pause is + -- Ignored_String : String( 1 .. 80 ); + -- Ignored_Last : Natural; + + begin + + -- + -- Really should be a "put" followed by a "flush." + -- + Text_IO.Put_Line( "<pause> " ); + -- Text_IO.Get_Line( Ignored_String, Ignored_Last ); + + end Pause; + +-- +-- Pause_And_Screen_Number +-- + + procedure Pause_And_Screen_Number ( + SCREEN : in RTEMS.Unsigned32 + ) is + -- Ignored_String : String( 1 .. 80 ); + -- Ignored_Last : Natural; + begin + + -- + -- Really should be a "put" followed by a "flush." + -- + Text_IO.Put( "<pause - screen " ); + Unsigned32_IO.Put( SCREEN, Width=>2 ); + Text_IO.Put_Line( "> " ); + -- Text_IO.Get_Line( Ignored_String, Ignored_Last ); + + end Pause_And_Screen_Number; + +-- +-- Put_Name +-- + + procedure Put_Name ( + Name : in RTEMS.Name; + New_Line : in Boolean + ) is + C1 : Character; + C2 : Character; + C3 : Character; + C4 : Character; + begin + + RTEMS.Name_To_Characters( Name, C1, C2, C3, C4 ); + + Text_IO.Put( C1 ); + Text_IO.Put( C2 ); + Text_IO.Put( C3 ); + Text_IO.Put( C4 ); + + if New_Line then + Text_IO.New_Line; + end if; + + end Put_Name; + +-- +-- Task_Number +-- + + function Task_Number ( + TID : in RTEMS.ID + ) return RTEMS.Unsigned32 is + begin + + -- probably OK + return RTEMS.Get_Index( TID ) - 1; + + end Task_Number; + +-- +-- Do_Nothing +-- + + procedure Do_Nothing is + begin + NULL; + end Do_Nothing; + + +-- +-- Milliseconds_Per_Tick +-- + + function Milliseconds_Per_Tick + return RTEMS.Unsigned32 is + function Milliseconds_Per_Tick_Base return RTEMS.Unsigned32; + pragma Import (C, Milliseconds_Per_Tick_Base, "milliseconds_per_tick"); + begin + return Milliseconds_Per_Tick_Base; + end Milliseconds_Per_Tick; + +-- +-- Milliseconds_Per_Tick +-- + function Ticks_Per_Second + return RTEMS.Interval is + function Ticks_Per_Second_Base return RTEMS.Unsigned32; + pragma Import (C, Ticks_Per_Second_Base, "ticks_per_second"); + begin + return Ticks_Per_Second_Base; + end Ticks_Per_Second; + +-- +-- Return the size of the RTEMS Workspace +-- + + function Work_Space_Size + return RTEMS.Unsigned32 is + function Work_Space_Size_Base return RTEMS.Unsigned32; + pragma Import (C, Work_Space_Size_Base, "work_space_size"); + begin + return Work_Space_Size_Base; + end Work_Space_Size; + +-- +-- Return an indication of whether multiprocessing is configured +-- + + function Is_Configured_Multiprocessing + return Boolean is + function Is_Configured_Multiprocessing_Base return RTEMS.Unsigned32; + pragma Import ( + C, Is_Configured_Multiprocessing_Base, "is_configured_multiprocessing" + ); + begin + if Is_Configured_Multiprocessing_Base = 1 then + return True; + else + return False; + end if; + end Is_Configured_Multiprocessing; + +-- +-- Node is the node number in a multiprocessor configuration +-- + + function Node + return RTEMS.Unsigned32 is + function Get_Node_Base return RTEMS.Unsigned32; + pragma Import (C, Get_Node_Base, "get_node"); + begin + return Get_Node_Base; + end Node; +end Test_Support; |