t_id
230
t_adddate
2003/10/03
t_result
0
t_knownrunerror
0
tr_id | run | tr_ok | tr_skip | tr_result |
---|---|---|---|---|
-90518033 | 847486 | True | False | Successfully run |
Record count: 1
{ Program to test OS-specific features of the system unit } { routines to test: } { do_open() } { do_read() } { do_write() } { do_close() } { do_filesize() } { do_seek() } { do_truncate() } { This routine overwrites/creates a filename called test.tmp } { fills it up with values, checks its file size, reads the } { data back in, } Program tio; {$I-} {$IFDEF TP} type shortstring = string; {$ENDIF} var F: File; procedure test(value, required: longint); begin if value <> required then begin writeln('Got ',value,' instead of ',required); halt(1); end; end; const FILE_NAME = 'test.tmp'; FILE_NAME2 = 'test1.tmp'; DATA_SIZE = 17; MODE_RESET = 0; MODE_REWRITE = 1; DATA: array[1..DATA_SIZE] of byte = ($01,$02,$03,$04,$05,$06,$07,$08, $09,$A,$B,$C,$D,$E,$F,$10, $11 ); procedure test_do_open(name : shortstring; mode: word); begin Write('opening file...'); Assign(F,name); test(IOResult, 0); if mode = MODE_REWRITE then Rewrite(F,1) else Reset(F,1); test(IOResult, 0); WriteLn('Passed!'); end; procedure test_do_write(var buf; BytesToWrite : longint); var BytesWritten : word; begin Write('writing to file...'); BlockWrite(F,buf,BytesToWrite,BytesWritten); test(IOResult, 0); if BytesWritten<>DATA_SIZE then RunError(255); Writeln('Passed!'); end; procedure test_do_filesize(size : longint); begin Write('getting filesize...'); { verifying if correct filesize } test(FileSize(F),size); { verify if IOError } test(IOResult, 0); WriteLn('Passed!'); end; procedure test_do_seek(_pos : longint); begin { Seek to beginning of file } Write('seek to beginning of file...'); Seek(F, _pos); test(IOResult, 0); WriteLn('Passed!'); end; procedure test_do_read(var buf; BytesToRead : word); var BytesRead : word; begin Write('reading from file...'); BlockRead(F,buf,BytesToRead,BytesRead); test(BytesToRead, BytesRead); test(IOResult, 0); WriteLn('Passed!'); end; procedure test_filepos(_pos : longint); var BytesRead : word; begin write('verifying file position...'); test(FilePos(F),_pos); test(IOResult, 0); WriteLn('Passed!'); end; procedure test_do_close; begin Write('closing file...'); Close(F); test(IOResult, 0); WriteLn('Passed!'); end; procedure test_rename(oldname, newname : shortstring); begin Assign(F,oldname); Write('renaming file...'); ReName(F,newname); test(IOResult, 0); WriteLn('Passed!'); end; procedure test_erase(name : shortstring); begin Assign(F,name); Write('erasing file...'); Erase(F); test(IOResult, 0); WriteLn('Passed!'); end; var I: Integer; readData : array[1..DATA_SIZE] of byte; Begin {------------------------ create and play with a new file --------------------------} FillChar(readData,DATA_SIZE,0); test_do_open(FILE_NAME, MODE_REWRITE); test_do_write(DATA, DATA_SIZE); test_do_filesize(DATA_SIZE); test_do_seek(0); test_do_read(readData, DATA_SIZE); for i:=1 to DATA_SIZE do Begin test(readData[i], data[i]); end; test_do_seek(5); test_filepos(5); (* test_do_truncate() WriteLn('truncating file...'); Truncate(F); WriteLn(FileSize(F)); if FileSize(F) <> 5 then RunError(255); *) test_do_close; {------------------------ create and play with an old file --------------------------} FillChar(readData,DATA_SIZE,0); test_do_open(FILE_NAME2, MODE_REWRITE); test_do_write(DATA, DATA_SIZE); test_do_close; FillChar(readData,DATA_SIZE,0); test_do_open(FILE_NAME2, MODE_RESET); test_do_write(DATA, DATA_SIZE); test_do_filesize(DATA_SIZE); test_do_seek(0); test_do_read(readData, DATA_SIZE); for i:=1 to DATA_SIZE do Begin test(readData[i], data[i]); end; test_do_close; test_rename(FILE_NAME2, 'test3.tmp'); test_erase(FILE_NAME); end. { $Log: tio.pp,v $ Revision 1.5 2002/09/07 15:40:56 peter * old logs removed and tabs fixed Revision 1.4 2002/03/05 21:53:53 carl + cleanup }