diff options
Diffstat (limited to 'c/src/ada-tests/support/test_support.adb')
| -rw-r--r-- | c/src/ada-tests/support/test_support.adb | 236 |
1 files changed, 236 insertions, 0 deletions
diff --git a/c/src/ada-tests/support/test_support.adb b/c/src/ada-tests/support/test_support.adb new file mode 100644 index 0000000000..6f4380c185 --- /dev/null +++ b/c/src/ada-tests/support/test_support.adb @@ -0,0 +1,236 @@ +-- +-- Test_Support / Specification +-- +-- DESCRIPTION: +-- +-- This package provides routines which aid the Test Suites +-- and simplify their design and operation. +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1989, 1990, 1991, 1992, 1993, 1994. +-- On-Line Applications Research Corporation (OAR). +-- All rights assigned to U.S. Government, 1994. +-- +-- This material may be reproduced by or for the U.S. Government pursuant +-- to the copyright license under the clause at DFARS 252.227-7013. This +-- notice must appear in all copies of this file and its derivatives. +-- +-- test_support.adb,v 1.2 1995/07/21 15:08:54 joel Exp +-- + +with Interfaces; use Interfaces; +with RTEMS; +with Unsigned32_IO; +with Status_IO; +with Text_IO; + +package body Test_Support is + +--PAGE +-- +-- 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; + +--PAGE +-- +-- 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; + +--PAGE +-- +-- 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; + +--PAGE +-- +-- Put_Dot +-- + + procedure Put_Dot ( + Buffer : in String + ) is + begin + Text_IO.Put( Buffer ); + Text_IO.FLUSH; + end Put_Dot; + +--PAGE +-- +-- 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 ); + + exception + + when Text_IO.End_Error => + -- ignore this error. It happens when redirecting input from /dev/null + return; + + end Pause; + +--PAGE +-- +-- 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 ); + + exception + + when Text_IO.End_Error => + -- ignore this error. It happens when redirecting input from /dev/null + return; + + end Pause_And_Screen_Number; + +--PAGE +-- +-- 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 = True then + Text_IO.New_Line; + end if; + + end Put_Name; + +--PAGE +-- +-- Task_Number +-- + + function Task_Number ( + TID : in RTEMS.ID + ) return RTEMS.Unsigned32 is + begin + + return RTEMS.Get_Index( TID ) - + RTEMS.Configuration.RTEMS_API_Configuration.Number_Of_Initialization_Tasks; + + end Task_Number; + +--PAGE +-- +-- Do_Nothing +-- + + procedure Do_Nothing is + begin + NULL; + end Do_Nothing; + + +--PAGE +-- +-- Milliseconds_Per_Tick +-- + + function Milliseconds_Per_Tick + return RTEMS.Unsigned32 is + begin + return RTEMS.Configuration.Microseconds_Per_Tick / 1000; + end Milliseconds_Per_Tick; +end Test_Support; |