소스 검색

+ new interactive test

pierre 22 년 전
부모
커밋
4504801212
2개의 변경된 파일57개의 추가작업 그리고 0개의 파일을 삭제
  1. 51 0
      tests/webtbs/tw1539.pp
  2. 6 0
      tests/webtbs/tw1909.pp

+ 51 - 0
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: [email protected] }
+
+{
+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.

+ 6 - 0
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.