mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-29 06:59:46 +02:00
+ new interactive test
This commit is contained in:
parent
7aa569d748
commit
4504801212
51
tests/webtbs/tw1539.pp
Normal file
51
tests/webtbs/tw1539.pp
Normal 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.
|
@ -23,5 +23,11 @@ var
|
|||||||
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
value_u8bit:=133;
|
||||||
proc_value_smallarray_const_1_inline([value_u8bit]);
|
proc_value_smallarray_const_1_inline([value_u8bit]);
|
||||||
|
if global_u8bit <> 133 then
|
||||||
|
begin
|
||||||
|
Writeln('Error in inline code generation');
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
end.
|
end.
|
||||||
|
Loading…
Reference in New Issue
Block a user