diff --git a/tests/webtbs/tw1539.pp b/tests/webtbs/tw1539.pp new file mode 100644 index 0000000000..1f605218ea --- /dev/null +++ b/tests/webtbs/tw1539.pp @@ -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. diff --git a/tests/webtbs/tw1909.pp b/tests/webtbs/tw1909.pp index d801c748b4..c1d6c718da 100644 --- a/tests/webtbs/tw1909.pp +++ b/tests/webtbs/tw1909.pp @@ -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.