-- -- 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( " " ); -- 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( "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.Size is function Work_Space_Size_Base return RTEMS.Size; 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;