From 8ac4a770a91d4164496ea1d519be29fad20cb8b0 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Wed, 30 Apr 2014 18:31:22 +0000 Subject: [PATCH] * check whether file/text is assigned in erase/rename (mantis #25932) git-svn-id: trunk@27694 - --- .gitattributes | 1 + rtl/inc/file.inc | 54 ++++++++++++++-------- rtl/inc/text.inc | 54 ++++++++++++++-------- tests/test/tw25932.pp | 105 ++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 174 insertions(+), 40 deletions(-) create mode 100644 tests/test/tw25932.pp diff --git a/.gitattributes b/.gitattributes index 4ebce22a90..b465dd405a 100644 --- a/.gitattributes +++ b/.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 diff --git a/rtl/inc/file.inc b/rtl/inc/file.inc index 8deaf8e3d9..8b986df03f 100644 --- a/rtl/inc/file.inc +++ b/rtl/inc/file.inc @@ -430,10 +430,14 @@ End; Procedure Erase(var f : File);[IOCheck]; Begin - If InOutRes <> 0 then - exit; - If FileRec(f).mode=fmClosed Then - Do_Erase(PFileTextRecChar(@FileRec(f).Name),false); + if InOutRes<>0 then + exit; + 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 - (FileRec(f).mode<>fmClosed) then + if InOutRes<>0 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 - (FileRec(f).mode<>fmClosed) then + if InOutRes<>0 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,19 +544,21 @@ End; var len: SizeInt Begin - If InOutRes<>0 then + if InOutRes<>0 then exit; - If FileRec(f).mode=fmClosed Then - Begin - Do_Rename(PFileTextRecChar(@FileRec(f).Name),p,false); - { check error code of do_rename } - 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; + if FileRec(f).mode<>fmClosed then + begin + InOutRes:=102; + exit; + end; + Do_Rename(PFileTextRecChar(@FileRec(f).Name),p,false); + { check error code of do_rename } + 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; {$endif FPC_HAS_FEATURE_ANSISTRINGS} diff --git a/rtl/inc/text.inc b/rtl/inc/text.inc index e2afb77874..75379c70da 100644 --- a/rtl/inc/text.inc +++ b/rtl/inc/text.inc @@ -255,10 +255,14 @@ End; Procedure Erase(var t:Text);[IOCheck]; Begin - If InOutRes <> 0 then - exit; - If TextRec(t).mode=fmClosed Then - Do_Erase(PFileTextRecChar(@TextRec(t).Name),false); + if InOutRes<>0 then + exit; + 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 - (TextRec(t).mode<>fmClosed) then + if InOutRes<>0 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 - (TextRec(t).mode<>fmClosed) then + if InOutRes<>0 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,19 +368,21 @@ End; var len: SizeInt Begin - If InOutRes<>0 then + if InOutRes<>0 then exit; - If TextRec(t).mode=fmClosed Then - Begin - Do_Rename(PFileTextRecChar(@TextRec(t).Name),p,false); - { check error code of do_rename } - 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; + if TextRec(f).mode<>fmClosed then + begin + InOutRes:=102; + exit; + end; + Do_Rename(PFileTextRecChar(@TextRec(t).Name),p,false); + { check error code of do_rename } + 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; {$endif FPC_HAS_FEATURE_ANSISTRINGS} diff --git a/tests/test/tw25932.pp b/tests/test/tw25932.pp new file mode 100644 index 0000000000..23b5d57f46 --- /dev/null +++ b/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. +