Test suite results for test file webtbs/tw1539.pp

Test run data :

Run ID:
Operating system: linux
Processor: x86_64
Version: 3.2.0
Fails/OK/Total: 30/7756/7786
Version: 3.2.0
Full version: 3.2.0-beta
Comment: -Cg -O4 -Criot -Fd
Machine: gcc121
Category: 1
SVN revisions: 20:44143:1:44109:1:44160:1:44148
Submitter: pierre
Date: 2020/02/18 02:40:00
Previous run: 487938
Next run: 488191

Hide skipped tests

Hide successful tests

Test file "webtbs/tw1539.pp" information:

t_id 828
t_adddate 2003/10/03
Flag t_interactive set
t_result 0
t_knownrunerror 0

Detailed test run results:

tr_idruntr_oktr_skiptr_result
2115327941488056FalseTrueSkipping test because it is interactive

Record count: 1

No log of 488056.

Source:

{ %interactive }
{ This test generates an error/retry box on windows }
{ Source provided for Free Pascal Bug Report 1539 }
{ Submitted by "Salvatore Licciardi" on  2001-06-30 }
{ e-mail: turylicciardi@tiscalinet.it }

{
If the floppy is protect to write, at the end
write(ItsPossible)=='TRUE' : ERROR
go32v2 on pure Dos specific
}
program MyProg;

uses
  dos,crt;

var
  copyfx:text;
  st:string;
  ItsPossible:boolean;

begin
  Writeln(' To test the bug, first insert a write protected floppy in a:');
  Write('Press Return when ready.');
  Readln(st);
  Assign(copyfx,'a:w');
  ItsPossible:=true;

{$i-}
  rewrite(copyfx);
{$i+}
  if ioresult<>0 then
    ItsPossible:=false
  else
    begin
{$i-}
      close(copyfx);
{$i+}
      if IOResult<>0 then
        ItsPossible:=false;
    end;
  write(ItsPossible);
  if ItsPossible then
    begin
{$i-}
      writeln(copyfx,'Simple write test');
{$i+}
      Writeln('InOutRes after write atempt = ',IOResult);
      Close(copyfx);
    end;
end.

Link to SVN view of webtbs/tw1539.pp source.