home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TSPA2550.ZIP / TSUNTH.TST < prev    next >
Encoding:
Text File  |  1991-07-22  |  4.1 KB  |  177 lines
  1. (* This is a test program for the TSUNTH.TPU unit 25-Feb-89
  2.    Updated 21-Mar-90, 23-Jul-90, 1-Aug-90, 5-Jan-91, 21-Jul-91 *)
  3.  
  4. uses Dos, TSUNTH;
  5.  
  6. procedure LOGO;
  7. begin
  8.   writeln;
  9.   writeln ('TSUNTH unit test by Prof. Timo Salmi, 21-Jul-91');
  10.   writeln ('University of Vaasa, Finland, ts@chyde.uwasa.fi');
  11.   writeln;
  12. end;  (* logo *)
  13.  
  14. (* Testing if graftabl is loaded *)
  15. procedure TEST1;
  16. begin
  17.   if GRTABLFN then
  18.      writeln ('GRAFTABL has been loaded')
  19.    else
  20.      writeln ('GRAFTABL has not been loaded');
  21. end;  (* test1 *)
  22.  
  23. (* Testing if c:\util is a directory *)
  24. procedure TEST2;
  25. var name : string;
  26. begin
  27.   name := 'c:\util';
  28.   writeln (name, ' is directory: ', ISDIRFN (name));
  29.   Flush (output);
  30. end;  (* test2 *)
  31.  
  32. (* Testing copy *)
  33. procedure TEST3;
  34. var file1, file2 : string;
  35.     status       : byte;
  36. begin
  37.   file1 := 'c:\command.com';
  38.   file2 := 'f:\command.com';
  39.   COPYFILE (file1, file2, status);
  40.   if status = 0 then
  41.      writeln (file1, ' copied to ', file2)
  42.    else
  43.      begin
  44.        writeln ('Error in copying ', file1, ' to ', file2);
  45.        writeln ('Status = ', status);
  46.      end;
  47. end;  (* test3 *)
  48.  
  49. (* Is a math coprocessor present *)
  50. procedure TEST4;
  51. begin
  52.   if MATHCOFN then
  53.      writeln ('A math coprocessor is present')
  54.    else
  55.      writeln ('No math coprocessor present');
  56. end;  (* test4 *)
  57.  
  58. (* Number of serial ports *)
  59. procedure TEST5;
  60. begin
  61.   writeln ('Number of serial ports ', RS232FN);
  62.   Flush (output);
  63. end;  (* test5 *)
  64.  
  65. (* Number of parallel ports *)
  66. procedure TEST6;
  67. begin
  68.   writeln ('Number of parallel ports ', PARPORFN);
  69.   Flush (output);
  70. end;  (* test6 *)
  71.  
  72. (* Country code *)
  73. procedure TEST7;
  74. begin
  75.   writeln ('The country code is ', COUNTRFN);
  76.   Flush (output);
  77. end;  (* test7 *)
  78.  
  79. (* Processor chip type *)
  80. procedure TEST8;
  81. begin
  82.   writeln ('The processor chip is ', CHIPFN);
  83.   Flush (output);
  84. end;  (* test8 *)
  85.  
  86. (* Get ROM BIOS version *)
  87. procedure TEST9;
  88. begin
  89.   writeln ('The ROM BIOS version (date) is ', ROMDTEFN);
  90.   Flush (output);
  91. end;  (* test9 *)
  92.  
  93. (* Is an enhanced keyboard present *)
  94. procedure TEST10;
  95. begin
  96.   if ISENHAFN then
  97.     writeln ('Enhanced keyboard')
  98.   else
  99.     writeln ('Not an enhanced keyboard');
  100. end;  (* test10 *)
  101.  
  102. (* Last drive, and interleave values *)
  103. procedure TEST11;
  104. var lastdrive  : char;
  105.     interleave : byte;
  106.     ch         : char;
  107. begin
  108.   lastdrive := LASTDRFN;
  109.   writeln ('The last drive on this system is ', lastdrive);
  110.   if lastdrive > 'B' then
  111.     for ch := 'C' to lastdrive do
  112.       writeln ('Drive ', ch, ' interleave is ', INTERLFN (ch));
  113.   writeln;
  114.   for ch := 'A' to lastdrive do
  115.     writeln ('Drive ', ch, ' number of FATs is ', FATSFN (ch));
  116. end;  (* test11 *)
  117.  
  118. (* Test where the standard input comes from, and where does the standard
  119.    output go to *)
  120. procedure TEST12;
  121. var s   : string;
  122.     con : text;
  123. begin
  124.   { We must have a way to write messages to the screen irrespective of
  125.     where the standard output is directed. }
  126.   assign (con, 'con');
  127.   rewrite (con);
  128.   {}
  129.   if PIPEDIFN then
  130.     writeln (con, 'Input from redirection')
  131.     else writeln (con, 'Input not from redirection');
  132.   {}
  133.   if PIPEDOFN then
  134.     writeln (con, 'Output redirected')
  135.     else writeln (con, 'Output not redirected');
  136.   {}
  137.   if PIPEDNFN then
  138.     writeln (con, 'Output redirected to nul')
  139.     else writeln (con, 'Output not redirected to nul');
  140.   {}
  141.   close (con);
  142. end;  (* test12 *)
  143.  
  144. (* Show date and time formats of your configuration *)
  145. procedure TEST13;
  146. begin
  147.   writeln ('The country-dependent date format is ', DATEFMFN);
  148.   writeln ('The country-dependent time format is ', TIMEFMFN);
  149. end;  (* test13 *)
  150.  
  151. procedure TEST14;
  152. const drive = 'A';
  153. begin
  154.    writeln ('Number of cylinders on ', drive, ', is ', NRCYLFN(drive));
  155. end;  (* test14 *)
  156.  
  157. procedure TEST15;
  158. begin
  159.    writeln ('The boot drive was ', BOOTDRFN);
  160. end;  (* test15 *)
  161.  
  162. (* Main program *)
  163. begin
  164.   LOGO;
  165.   TEST4;
  166.   TEST5;
  167.   TEST6;
  168.   TEST7;
  169.   TEST8;
  170.   TEST9;
  171.   TEST10;
  172.   {}
  173.   {... if you want the rest of the tests, just include them ...}
  174.   {}
  175.   write ('Press <═╝'); readln;
  176. end.  (* tsunth.tst *)
  177.