* check whether file/text is assigned in erase/rename (mantis #25932)

git-svn-id: trunk@27694 -

.gitattributes

@@ -12144,6 +12144,7 @@ tests/test/tutf82.pp svneol=native#text/plain
 tests/test/tvarpropsetter1.pp svneol=native#text/plain
 tests/test/tvarpropsetter2.pp svneol=native#text/plain
 tests/test/tvarset1.pp svneol=native#text/plain
+tests/test/tw25932.pp svneol=native#text/plain
 tests/test/twarn1.pp svneol=native#text/pascal
 tests/test/tweaklib1.pp svneol=native#text/plain
 tests/test/tweaklib2.pp svneol=native#text/plain

rtl/inc/file.inc

@@ -430,9 +430,13 @@ End;
 
 Procedure Erase(var f : File);[IOCheck];
 Begin
-  If InOutRes <> 0 then
+  if InOutRes<>0 then
     exit;
-  If FileRec(f).mode=fmClosed Then
+  if FileRec(f).mode<>fmClosed then
+    begin
+      InOutRes:=102;
+      exit;
+    end;
   Do_Erase(PFileTextRecChar(@FileRec(f).Name),false);
 End;
 
@@ -443,9 +447,13 @@ var
   fs: RawByteString;
 {$endif FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
 Begin
-  If (InOutRes<>0) or
+  if InOutRes<>0 then
-     (FileRec(f).mode<>fmClosed) then
     exit;
+  if FileRec(f).mode<>fmClosed then
+    begin
+      InOutRes:=102;
+      exit;
+    end;
 {$ifdef FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
   { it's slightly faster to convert the unicodestring here to rawbytestring
     than doing it in do_rename(), because here we still know the length }
@@ -476,9 +484,13 @@ var
 {$endif FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
   dstchangeable: boolean;
 Begin
-  If (InOutRes<>0) or
+  if InOutRes<>0 then
-     (FileRec(f).mode<>fmClosed) then
     exit;
+  if FileRec(f).mode<>fmClosed then
+    begin
+      InOutRes:=102;
+      exit;
+    end;
 {$ifdef FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
   dstchangeable:=false;
   pdst:=PAnsiChar(s);
@@ -532,20 +544,22 @@ End;
 var
   len: SizeInt
 Begin
-  If InOutRes<>0 then
+  if InOutRes<>0 then
     exit;
-  If FileRec(f).mode=fmClosed Then
+  if FileRec(f).mode<>fmClosed then
-    Begin
+    begin
+      InOutRes:=102;
+      exit;
+    end;
   Do_Rename(PFileTextRecChar(@FileRec(f).Name),p,false);
   { check error code of do_rename }
-      If InOutRes=0 then
+  if InOutRes=0 then
     begin
       len:=min(StrLen(p),high(FileRec(f).Name));
       Move(p^,FileRec(f).Name,len);
       FileRec(f).Name[len]:=#0;
     end;
 End;
-End;
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 
 

rtl/inc/text.inc

@@ -255,9 +255,13 @@ End;
 
 Procedure Erase(var t:Text);[IOCheck];
 Begin
-  If InOutRes <> 0 then
+  if InOutRes<>0 then
     exit;
-  If TextRec(t).mode=fmClosed Then
+  if TextRec(t).mode<>fmClosed then
+    begin
+      InOutRes:=102;
+      exit;
+    end;
   Do_Erase(PFileTextRecChar(@TextRec(t).Name),false);
 End;
 
@@ -268,9 +272,13 @@ var
   fs: RawByteString;
 {$endif FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
 Begin
-  If (InOutRes<>0) or
+  if InOutRes<>0 then
-     (TextRec(t).mode<>fmClosed) then
     exit;
+  if TextRec(t).mode<>fmClosed then
+    begin
+      InOutRes:=102;
+      exit;
+    end;
 {$ifdef FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
   { it's slightly faster to convert the unicodestring here to rawbytestring
     than doing it in do_rename(), because here we still know the length }
@@ -301,9 +309,13 @@ var
 {$endif FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
   dstchangeable: boolean;
 Begin
-  If (InOutRes<>0) or
+  if InOutRes<>0 then
-     (TextRec(t).mode<>fmClosed) then
     exit;
+  if TextRec(t).mode<>fmClosed then
+    begin
+      InOutRes:=102;
+      exit;
+    end;
 {$ifdef FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
   dstchangeable:=false;
   pdst:=PAnsiChar(s);
@@ -356,20 +368,22 @@ End;
 var
   len: SizeInt
 Begin
-  If InOutRes<>0 then
+  if InOutRes<>0 then
     exit;
-  If TextRec(t).mode=fmClosed Then
+  if TextRec(f).mode<>fmClosed then
-    Begin
+    begin
+      InOutRes:=102;
+      exit;
+    end;
   Do_Rename(PFileTextRecChar(@TextRec(t).Name),p,false);
   { check error code of do_rename }
-      If InOutRes=0 then
+  if InOutRes=0 then
     begin
       len:=min(StrLen(p),high(TextRec(t).Name));
       Move(p^,TextRec(t).Name,len);
       TextRec(t).Name[len]:=#0;
     end;
 End;
-End;
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 
 Procedure Rename(var t : Text;const c : AnsiChar);[IOCheck];

tests/test/tw25932.pp

@@ -0,0 +1,105 @@
+{$mode delphi}
+
+uses
+  sysutils;
+
+procedure testfile;
+var
+  f: file;
+  s: shortstring;
+  a: ansistring;
+  u: unicodestring;
+begin
+  s:='a';
+  a:='b';
+  u:='c';
+
+  fillchar(f,sizeof(f),0);
+  try
+    erase(f);
+  except
+    on e: EInOutError do
+     if e.ErrorCode<>102 then
+       raise
+  end;
+
+  fillchar(f,sizeof(f),0);
+  try
+    rename(f,s);
+  except
+    on e: EInOutError do
+     if e.ErrorCode<>102 then
+       raise
+  end;
+
+  fillchar(f,sizeof(f),0);
+  try
+    rename(f,a);
+  except
+    on e: EInOutError do
+     if e.ErrorCode<>102 then
+       raise
+  end;
+
+  fillchar(f,sizeof(f),0);
+  try
+    rename(f,u);
+  except
+    on e: EInOutError do
+     if e.ErrorCode<>102 then
+       raise
+  end;
+end;
+
+procedure testtext;
+var
+  f: text;
+  s: shortstring;
+  a: ansistring;
+  u: unicodestring;
+begin
+  s:='a';
+  a:='b';
+  u:='c';
+
+  fillchar(f,sizeof(f),0);
+  try
+    erase(f);
+  except
+    on e: EInOutError do
+     if e.ErrorCode<>102 then
+       raise
+  end;
+
+  fillchar(f,sizeof(f),0);
+  try
+    rename(f,s);
+  except
+    on e: EInOutError do
+     if e.ErrorCode<>102 then
+       raise
+  end;
+
+  fillchar(f,sizeof(f),0);
+  try
+    rename(f,a);
+  except
+    on e: EInOutError do
+     if e.ErrorCode<>102 then
+       raise
+  end;
+
+  fillchar(f,sizeof(f),0);
+  try
+    rename(f,u);
+  except
+    on e: EInOutError do
+     if e.ErrorCode<>102 then
+       raise
+  end;
+end;
+
+begin
+  testfile;
+end.
+