Braille_display_test (braille_display_test.adb):

--  © 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;
Braille_display_test (braille_display_test.adb):

Go to ...
