-- (C) Copyright 2000 by John Halleck, All Rights Reserved. -- Test the Braille.Display package. with Ada.Text_IO; use Ada.Text_IO; with Ada.Command_Line; use Ada.Command_Line; with Braille; use Braille; with Braille.Display; use Braille.Display; procedure Braille_Display_TEST is -- Local functions. function Bad (A_Cell : Cell; A_Display : Display_Cell) return Boolean; procedure Dump (A_Cell : Display_Cell); -- And with the show. Test_Status : Exit_Status := Success; Overall_Status : Exit_Status := Success; Result : Display_Cell; function Bad (A_Cell : Cell; A_Display : Display_Cell) return Boolean is begin return (((Dot_1 and A_Cell) /= 0) xor (A_Display (1) (1) = '*')) or else (((Dot_2 and A_Cell) /= 0) xor (A_Display (2) (1) = '*')) or else (((Dot_3 and A_Cell) /= 0) xor (A_Display (3) (1) = '*')) or else (((Dot_4 and A_Cell) /= 0) xor (A_Display (1) (2) = '*')) or else (((Dot_5 and A_Cell) /= 0) xor (A_Display (2) (2) = '*')) or else (((Dot_6 and A_Cell) /= 0) xor (A_Display (3) (2) = '*')); end Bad; procedure Dump (A_Cell : Display_Cell) is begin Put (" "); Put (String (A_Cell (1))); New_Line; Put (" "); Put (String (A_Cell (2))); New_Line; Put (" "); Put (String (A_Cell (3))); New_Line; end Dump; begin Put_Line ("Braille.Display test starting ..."); Put (" Individual cell mapping test ..."); Test_Status := Success; for I in Cell'(0) .. 63 loop Result := Translate (I); if Bad (I, Result) then if Test_Status /= Failure then Test_Status := Failure; Put_Line (" *** FAILED ***"); end if; Put (" Cell "); Put (Cell'Image (I)); Put (" produced "); New_Line; Dump (Result); end if; end loop; if Test_Status = Failure then Overall_Status := Failure; else New_Line; end if; Test_Status := Success; Put (" Empty cell without supression test..."); Result := Translate (Empty, False); if Result /= Blank_Cell then Test_Status := Failure; Overall_Status := Failure; Put_Line ("*** Failed ***"); Put_Line ("Got:"); Dump (Result); Put_Line ("Expected:"); Dump (Blank_Cell); else New_Line; end if; Test_Status := Success; Put (" Empty Cell with suppression test ..."); Result := Translate (Empty, True); if Result /= Suppressed_Cell then Test_Status := Failure; Overall_Status := Failure; Put_Line ("*** Failed ***"); Put_Line ("Got"); Dump (Result); Put_Line ("Expected:"); Dump (Suppressed_Cell); else New_Line; end if; Put ("Braille.Display test "); if Overall_Status = Failure then Put ("****** FAILED ******"); else Put ("--- Passed! ---"); end if; New_Line; Set_Exit_Status (Overall_Status); end Braille_Display_TEST;