diff options
Diffstat (limited to 'c/src/ada-tests/support/test_support.adb')
| -rw-r--r-- | c/src/ada-tests/support/test_support.adb | 266 |
1 files changed, 0 insertions, 266 deletions
diff --git a/c/src/ada-tests/support/test_support.adb b/c/src/ada-tests/support/test_support.adb deleted file mode 100644 index bc636cee11..0000000000 --- a/c/src/ada-tests/support/test_support.adb +++ /dev/null @@ -1,266 +0,0 @@ --- --- 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; |