Kaynağa Gözat

* *Dir(<ansistring>) functions need to check io result as well, resolves #19977

git-svn-id: trunk@18209 -
florian 14 yıl önce
ebeveyn
işleme
63403e5199
3 değiştirilmiş dosya ile 31 ekleme ve 3 silme
  1. 1 0
      .gitattributes
  2. 3 3
      rtl/objpas/objpas.pp
  3. 27 0
      tests/webtbs/tw19977.pp

+ 1 - 0
.gitattributes

@@ -11724,6 +11724,7 @@ tests/webtbs/tw19910.pp svneol=native#text/pascal
 tests/webtbs/tw1996.pp svneol=native#text/plain
 tests/webtbs/tw19960.pp svneol=native#text/pascal
 tests/webtbs/tw19974.pp svneol=native#text/pascal
+tests/webtbs/tw19977.pp svneol=native#text/pascal
 tests/webtbs/tw2001.pp svneol=native#text/plain
 tests/webtbs/tw2002.pp svneol=native#text/plain
 tests/webtbs/tw2004.pp svneol=native#text/plain

+ 3 - 3
rtl/objpas/objpas.pp

@@ -249,17 +249,17 @@ end;
 
 
 {$ifdef FPC_HAS_FEATURE_FILEIO}
-Procedure MkDir(const s:ansistring);
+Procedure MkDir(const s:ansistring);[IOCheck];
 begin
   mkdirpchar(pchar(s),length(s));
 end;
 
-Procedure RmDir(const s:ansistring);
+Procedure RmDir(const s:ansistring);[IOCheck];
 begin
   RmDirpchar(pchar(s),length(s));
 end;
 
-Procedure ChDir(const s:ansistring);
+Procedure ChDir(const s:ansistring);[IOCheck];
 begin
   ChDirpchar(pchar(s),length(s));
 end;

+ 27 - 0
tests/webtbs/tw19977.pp

@@ -0,0 +1,27 @@
+{$mode objfpc}{$H+}
+{$I+}
+
+uses SysUtils;
+
+const
+  NotExistingDir = {$ifdef UNIX} '/not_existing_directory_kambi_test' {$endif}
+                   {$ifdef MSWINDOWS} 'c:/not_existing_directory_kambi_test' {$endif}
+                   {$ifdef GO32V2} 'c:/not_existing_directory_kambi_test' {$endif};
+begin
+  try
+    ChDir(NotExistingDir);
+    Assert(false, 'ChDir to ' + NotExistingDir + ' didn''t raise an exception');
+  except
+    on E: EInOutError do Writeln('Ok, ChDir raised exception');
+  end;
+
+  try
+    Writeln('We are somewhere after ChDir');
+  except
+    on E: EInOutError do 
+      begin
+        Writeln('Ups, Writeln raised exception');
+        halt(1);
+      end;
+  end;
+end.