home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TSPA3260.ZIP / TSUNTE.TST < prev    next >
Encoding:
Text File  |  1993-01-23  |  5.0 KB  |  204 lines
  1. (* This is a test program for the TSUNTE.TPU unit 19-Aug-89,
  2.    Updated 24-Sep-89, 8-Oct-89, 4-Nov-89, 4-Dec-89, 17-Jul-90,
  3.            26-Aug-92, 5-Oct-92, 23-Jan-93 *)
  4.  
  5. uses Dos, TSUNTE;
  6.  
  7. procedure LOGO;
  8. begin
  9.   writeln;
  10.   writeln ('TSUNTE unit test by Prof. Timo Salmi');
  11.   writeln ('University of Vaasa, Finland, ts@uwasa.fi');
  12. {$IFDEF VER40}
  13.   writeln ('TP version 4.0');
  14. {$ENDIF}
  15. {$IFDEF VER50}
  16.   writeln ('TP version 5.0');
  17. {$ENDIF}
  18. {$IFDEF VER55}
  19.   writeln ('TP version 5.5');
  20. {$ENDIF}
  21. {$IFDEF VER60}
  22.   writeln ('TP version 6.0');
  23. {$ENDIF}
  24. {$IFDEF VER70}
  25.   writeln ('TP version 7.0');
  26. {$ENDIF}
  27.   writeln;
  28. end;  (* logo *)
  29.  
  30. (* Testing the cursor routines *)
  31. procedure TEST1;
  32. begin
  33.   CURSOFF;
  34.   writeln ('Cursor is off, press <═╝');
  35.   CLB;
  36.   readln;
  37.   CURSON;
  38.   writeln ('Cursor is on, press <═╝');
  39.   CLB;
  40.   readln;
  41.   CURSOR (0, 13);
  42.   writeln ('Cursor is big, press <═╝');
  43.   CLB;
  44.   readln;
  45.   CURSOR (6, 7);
  46.   writeln ('Cursor is normal, press <═╝');
  47.   CLB;
  48.   readln;
  49. end;  (* test1 *)
  50.  
  51. (* The most common system clock weekday *)
  52. procedure TEST2;
  53. const wkday : string[21] = 'SunMonTueWedThuFriSat';
  54. begin
  55.   writeln ('25-7-1980 was ', Copy (wkday, 3*WKDAYFN(25,7,1980)+1, 3));
  56.   writeln ('Week number ', WEEKNRFN (25,7,1980,false));
  57. end;  (* test2 *)
  58.  
  59. (* Special key status *)
  60. procedure TEST5;
  61. begin
  62.   if CAPSONFN then writeln ('CapsLock on') else writeln ('CapsLock off');
  63.   if NUMLONFN then writeln ('NumLock on') else writeln ('NumLock off');
  64.   if SCRLONFN then writeln ('ScrollLock on') else writeln ('ScrollLock off');
  65. end;  (* test5 *)
  66.  
  67. (* Existence and size of a file
  68.    IMPORTANT: Never apply on an open file! *)
  69. procedure TEST6;
  70. var fname : string;
  71. begin
  72.   fname := 'a:\command.com';          {Alter fname as appropriate}
  73.   if FEXISTFN (fname) then            {**************************}
  74.      begin
  75.        writeln ('File ', fname, ' size ', FSIZEFN(fname), ' bytes');
  76. {$IFNDEF VER40}
  77.        writeln ('The allocated size is ', ALLSIZFN(fname), ' bytes');
  78. {$ENDIF}
  79.      end
  80.    else
  81.      writeln ('File ', fname, ' does not exist');
  82. end;  (* test6 *)
  83.  
  84. (* Get the entire command line, spaces and all *)
  85. procedure TEST7;
  86. begin
  87.   writeln;
  88.   writeln ('Command line = ', CMDLNFN);
  89.   writeln;
  90. end;  (* test7 *)
  91.  
  92. (* Demonstrate keyboard status, observe your keyboard status leds *)
  93. procedure TEST8;
  94. const loop = 100000;  { adjust to your PC speed if necessary }
  95. var i, j : longint;
  96. begin
  97.   for j := 1 to 10 do
  98.     begin
  99.       CAPS (true);
  100.       NUMLOCK (false);
  101.       SCRLOCK (true);
  102.       if j = 1 then TEST5;
  103.       for i := 1 to loop do;
  104.       CAPS (false);
  105.       NUMLOCK (true);
  106.       SCRLOCK (false);
  107.       for i := 1 to loop do;
  108.     end;
  109.   TEST5;
  110. end;  (* test8 *)
  111.  
  112. (* The number of days in a given month and year *)
  113. procedure TEST9;
  114. var month, year : word;
  115. begin
  116.   month := 7;
  117.   year  := 1990;
  118.   writeln ('The last day of ', month, '-', year, ' is ',
  119.             LASTDMFN (month, year));
  120.   Flush (output);
  121.   month := 2;
  122.   year := 1988;
  123.   writeln ('The last day of ', month, '-', year, ' is ',
  124.             LASTDMFN (month, year));
  125.   Flush (output);
  126. end;  (* test9 *)
  127.  
  128. (* Test the validity of a date *)
  129. procedure TEST10;
  130. var day, month, year : word;
  131. begin
  132.   day   := 22;
  133.   month := 7;
  134.   year  := 1990;
  135.   write ('Date ', day, '-', month, '-', year);
  136.   if DATEOKFN (day, month, year) then
  137.      writeln (' is valid')
  138.    else
  139.      writeln (' is NOT valid');
  140. end;  (* test10 *)
  141.  
  142. (* Test which date is earlier *)
  143. procedure TEST11;
  144. var day, month, year                 : word;
  145.     daynow, monthnow, yearnow, dummy : word;
  146.     z, znow                          : real;
  147. begin
  148.   GetDate (yearnow, monthnow, daynow, dummy);
  149.   day   := 22;
  150.   month := 7;
  151.   year  := 1990;
  152.   write ('Date ', day, '-', month, '-', year);
  153.   z    := ZELLERFN (day, month, year);
  154.   znow := ZELLERFN (daynow, monthnow, yearnow);
  155.   if z = znow then
  156.      writeln (' is today')
  157.    else if z < znow then
  158.      writeln (' is earlier than today')
  159.    else
  160.      writeln (' is later than today');
  161. end;  (* test11 *)
  162.  
  163. {$IFNDEF VER40}  (* Not Turbo Pascal 4.0 *)
  164. (* Get the default drive and its label *)
  165. procedure TEST12;
  166. var drive : char;
  167. begin
  168.   drive := DEFDRVFN;
  169.   writeln ('Label on ', drive, ' is ', LABELFN (drive));
  170.   Flush (output);
  171. end;  (* test12 *)
  172. {$ENDIF}
  173.  
  174. (* Attributes of files *)
  175. procedure TEST13;
  176. const FileName = 'c:\msdos.sys';
  177. begin
  178.   writeln (FileName, ' is read-only = ', RDOFILFN (FileName));
  179.   Flush (output);
  180.   {}
  181.   writeln (FileName, ' is hidden = ', HIDFILFN (FileName));
  182.   Flush (output);
  183.   {}
  184.   writeln (FileName, ' is a system file = ', SYSFILFN (FileName));
  185.   Flush (output);
  186.   {}
  187.   writeln (FileName, ' arcvive bit on = ', ARCFILFN (FileName));
  188.   Flush (output);
  189. end;  (* test13 *)
  190.  
  191. (* Main program *)
  192. begin
  193.   LOGO;
  194.   BORDER(5);
  195.   {$IFNDEF VER40} TEST7; {$ENDIF}
  196.   TEST1;
  197.   TEST2;
  198.   TEST5;
  199.   TEST6;
  200.   write ('Press <═╝'); readln;
  201.   BORDER(0);
  202.   { If you want the rest of the test, insert the calls }
  203. end.  (* tsunte.tst *)
  204.