home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TSPAS19.ZIP / TSUNTC.TST < prev    next >
Encoding:
Text File  |  1990-02-25  |  1.3 KB  |  61 lines
  1. (* This is a test program for the TSUNTC.TPU unit
  2.    Updated 19-Aug-89, 12-Nov-89
  3. *)
  4.  
  5. uses Dos,
  6.      Crt,
  7.      TSUNTC;
  8.  
  9. procedure LOGO;
  10. begin
  11.   writeln;
  12.   writeln ('TSUNTC unit test by Prof. Timo Salmi, 19-Aug-89');
  13.   writeln ('University of Vaasa, Finland, ts@chyde.uwasa.fi');
  14.   writeln;
  15. end;
  16.  
  17. (* Don't play it again, Sam *)
  18. procedure TEST1;
  19. const tune : array [1..7] of string[2]
  20.            = ('c ', 'd ', 'e ', 'f ', 'g ', 'a ', 'b ');
  21. var i : byte;
  22. begin
  23.   Delay (100);
  24.   for i := 1 to 7 do PLAYNOTE (tune[i], 4, 400);
  25.   PLAYNOTE ('c', 5, 400);
  26. end;  (* test1 *)
  27.  
  28. (* Printer status retort *)
  29. procedure TEST3;
  30. begin
  31.   if PRTONLFN then
  32.     writeln ('Printer ready')
  33.   else
  34.     writeln ('Printer not ready');
  35. end;  (* test3 *)
  36.  
  37. (* Number of disk devices *)
  38. procedure TEST4;
  39. begin
  40. {$IFDEF VER50}
  41.   if Lo(DosVersion) < 3 then
  42.     begin writeln ('Not MsDos 3.+'); exit; end;
  43. {$ENDIF}
  44.   writeln ('Number of disks in the system is ', DSKCNTFN);
  45. end;  (* test4 *)
  46.  
  47. (* Main program
  48.    If you don't want a particular test, comment it away.
  49.    Q: Why don't software firms test their programs properly themselves
  50.       but leave it to the gullible user?
  51.    A: Because it is such a testing task (do I detect audible groans :-)
  52. *)
  53. begin
  54.   LOGO;
  55.   TEST1;
  56.   REVCOLOR;
  57.   TEST3;
  58.   REVCOLOR;
  59.   TEST4;
  60. end.  (* tsuntc.tst *)
  61.