+ new interactive test

This commit is contained in:
pierre 2002-12-04 22:08:49 +00:00
parent 7aa569d748
commit 4504801212
2 changed files with 57 additions and 0 deletions

51
tests/webtbs/tw1539.pp Normal file
View File

@ -0,0 +1,51 @@
{ %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.

View File

@ -23,5 +23,11 @@ var
begin
value_u8bit:=133;
proc_value_smallarray_const_1_inline([value_u8bit]);
if global_u8bit <> 133 then
begin
Writeln('Error in inline code generation');
Halt(1);
end;
end.