home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TSPA3260.ZIP / TSUNTJ.TST < prev    next >
Encoding:
Text File  |  1992-11-07  |  2.6 KB  |  105 lines
  1. (* This is a test program for the TSUNTJ.TPU unit *)
  2.  
  3. uses TSUNTJ,
  4.      TSUNTB;  { for the HEXFN in procedure TEST4 }
  5.  
  6. procedure LOGO;
  7. begin
  8.   writeln;
  9.   writeln ('TSUNTJ unit test by Prof. Timo Salmi, 7-Nov-92');
  10.   writeln ('University of Vaasa, Finland, ts@uwasa.fi');
  11. {$IFDEF VER40}
  12.   writeln ('TP version 4.0');
  13. {$ENDIF}
  14. {$IFDEF VER50}
  15.   writeln ('TP version 5.0');
  16. {$ENDIF}
  17. {$IFDEF VER55}
  18.   writeln ('TP version 5.5');
  19. {$ENDIF}
  20. {$IFDEF VER60}
  21.   writeln ('TP version 6.0');
  22. {$ENDIF}
  23.   writeln;
  24. end;  (* logo *)
  25.  
  26. (* Testing copy *)
  27. procedure TEST1;
  28. var file1, file2 : string;
  29.     status       : byte;
  30. begin
  31.   file1 := 'c:\command.com';
  32.   file2 := 'r:\command.com';
  33.   COPYFILE (file1, file2, status);
  34.   if status = 0 then
  35.      writeln (file1, ' copied to ', file2)
  36.    else
  37.      begin
  38.        writeln ('Error in copying ', file1, ' to ', file2);
  39.        writeln ('Status = ', status);
  40.      end;
  41. end;  (* test1 *)
  42.  
  43. (* Testing if the given name is a directory *)
  44. procedure TEST2;
  45. var name : string;
  46.     b    : boolean;
  47. begin
  48.   name := ParamStr(1);
  49.   b := ISDIRFN (name);
  50.   writeln (name, ' is a directory: ', b);
  51.   b := ISDIR2FN (name);
  52.   writeln (name, ' is a directory: ', b);
  53. end;  (* test2 *)
  54.  
  55. (* Test where the standard input comes from, and where does the standard
  56.    output go to *)
  57. procedure TEST3;
  58. var s   : string;
  59.     con : text;
  60. begin
  61.   { We must have a way to write messages to the screen irrespective of
  62.     where the standard output is directed. }
  63.   assign (con, 'con');
  64.   rewrite (con);
  65.   {}
  66.   if PIPEDIFN then
  67.     writeln (con, 'Input from redirection')
  68.     else writeln (con, 'Input not from redirection');
  69.   {}
  70.   if PIPEDOFN then
  71.     writeln (con, 'Output redirected')
  72.     else writeln (con, 'Output not redirected');
  73.   {}
  74.   if PIPEDNFN then
  75.     writeln (con, 'Output redirected to nul')
  76.     else writeln (con, 'Output not redirected to nul');
  77.   {}
  78.   close (con);
  79. end;  (* test3 *)
  80.  
  81. (* Show interrupt information *)
  82. procedure TEST4;
  83. const intn : byte = $1F;  { graphics display character table }
  84. var segm, offs : word;
  85. begin
  86.   INTRLOCA (intn, segm, offs);
  87.   writeln ('Interrupt $', HEXFN(intn), ' is located at [',
  88.             HEXFN(segm),':$', HEXFN(offs), ']');
  89.   INTRADDR (intn, segm, offs);
  90.   writeln ('Interrupt $', HEXFN(intn), ' points to mem [',
  91.             HEXFN(segm),':$', HEXFN(offs), ']');
  92. end;  (* test4 *)
  93.  
  94. (* Main program *)
  95. begin
  96.   LOGO;
  97.   {      If you want test other than 2, remove the two bracket lines
  98.   TEST1;
  99.   TEST3;
  100.   TEST4;
  101.   write ('Press <═╝'); readln;
  102.   }
  103.   TEST2;
  104. end.  (* tsuntj.tst *)
  105.