diff -r 2fc958e10857 -r 922e035d4fde Class.st --- a/Class.st Fri Jul 05 01:07:48 2013 +0200 +++ b/Class.st Fri Jul 05 01:12:52 2013 +0200 @@ -1674,34 +1674,33 @@ source "return the classes full source code" - |code aStream tmpFilename| + |code aStream| " this is too slow for big classes (due to the emphasis stored)... code := String new:1000. aStream := WriteStream on:code. self fileOutOn:aStream " - tmpFilename := Filename newTemporary. [ - aStream := tmpFilename newReadWriteStream. - aStream removeOnClose:true. + aStream := FileStream newTemporary. + aStream removeOnClose:true. ] on:OpenError do:[:ex| - self warn:'Class>>#source: cannot create temporary file: ', ex description. - ^ nil + self warn:'Class>>#source: cannot create temporary file: ', ex description. + ^ nil ]. [ - FileOutErrorSignal handle:[:ex | - aStream nextPut:$" ; nextPutAll:ex description; nextPut:$". - FileOutErrorSignal isHandled ifTrue:[ - ex reject. - ]. - ] do:[ - self fileOutOn:aStream. - ]. - aStream reset. - code := aStream contents. + FileOutErrorSignal handle:[:ex | + aStream nextPut:$" ; nextPutAll:ex description; nextPut:$". + FileOutErrorSignal isHandled ifTrue:[ + ex reject. + ]. + ] do:[ + self fileOutOn:aStream. + ]. + aStream reset. + code := aStream contents. ] ensure:[ - aStream close. + aStream close. ]. ^ code @@ -2405,7 +2404,7 @@ "Modified: 22.3.1997 / 16:12:17 / cg" ! -fileOutAs:fileNameString +fileOutAs:filenameString "create a file consisting of all methods in myself in sourceForm, from which the class can be reconstructed (by filing in). The given fileName should be a full path, including suffix. @@ -2414,8 +2413,8 @@ Also, since the classes methods need a valid sourcefile, the current sourceFile may not be rewritten." - |aStream fileName newFileName savFilename needRename - mySourceFileName sameFile s mySourceFileID anySourceRef| + |filename fileExists needRename + mySourceFileName sameFile s mySourceFileID anySourceRef outStream savFilename| self isLoaded ifFalse:[ ^ FileOutErrorSignal @@ -2423,105 +2422,103 @@ errorString:' - will not fileOut unloaded class: ', self name ]. - fileName := fileNameString asFilename. + filename := filenameString asFilename. " if file exists, copy the existing to a .sav-file, create the new file as XXX.new-file, and, if that worked rename afterwards ... " - (fileName exists) ifTrue:[ - sameFile := false. - - "/ check carefully - maybe, my source does not really come from that - "/ file (i.e. all of my methods have their source as string) - - anySourceRef := false. - self instAndClassMethodsDo:[:m | - m sourcePosition notNil ifTrue:[ - anySourceRef := true - ] - ]. - - anySourceRef ifTrue:[ - s := self sourceStream. - s notNil ifTrue:[ - OperatingSystem isUNIXlike ifTrue:[ - mySourceFileID := s pathName asFilename info id. - sameFile := (fileName info id) == mySourceFileID. - ] ifFalse:[ - mySourceFileID := s pathName asFilename asAbsoluteFilename. - sameFile := (fileName asFilename asAbsoluteFilename) = mySourceFileID. - ]. - s close. - ] ifFalse:[ - classFilename notNil ifTrue:[ - " - check for overwriting my current source file - this is not allowed, since it would clobber my methods source - file ... you have to save it to some other place. - This happens if you ask for a fileOut into the source-directory - (from which my methods get their source) - " - mySourceFileName := Smalltalk getSourceFileName:classFilename. - sameFile := (fileNameString = mySourceFileName). - sameFile ifFalse:[ - mySourceFileName notNil ifTrue:[ - OperatingSystem isUNIXlike ifTrue:[ - sameFile := (fileName info id) == (mySourceFileName asFilename info id) - ] - ] - ]. + [ + fileExists := filename exists. + fileExists ifTrue:[ + sameFile := false. + + "/ check carefully - maybe, my source does not really come from that + "/ file (i.e. all of my methods have their source as string) + + anySourceRef := false. + self instAndClassMethodsDo:[:m | + m sourcePosition notNil ifTrue:[ + anySourceRef := true ] ]. - ]. - - sameFile ifTrue:[ - ^ FileOutErrorSignal - raiseRequestWith:fileNameString - errorString:(' - may not overwrite sourcefile: %1\try again after loading sources in the browser' withCRs bindWith:fileNameString) - ]. - - savFilename := Filename newTemporary. - fileName copyTo:savFilename. - newFileName := fileName withSuffix:'new'. - needRename := true - ] ifFalse:[ - "/ another possible trap: if my sourceFileName is - "/ the same as the written one AND the new files directory - "/ is along the sourcePath, we also need a temporary file - "/ first, to avoid accessing the newly written file. - - anySourceRef := false. - self instAndClassMethodsDo:[:m | - |mSrc| - - (mSrc := m sourceFilename) notNil ifTrue:[ - mSrc asFilename baseName = fileName baseName ifTrue:[ - anySourceRef := true + + anySourceRef ifTrue:[ + s := self sourceStream. + s notNil ifTrue:[ + OperatingSystem isUNIXlike ifTrue:[ + mySourceFileID := s pathName asFilename info id. + sameFile := (filename info id) == mySourceFileID. + ] ifFalse:[ + mySourceFileID := s pathName asFilename asAbsoluteFilename. + sameFile := (filename asFilename asAbsoluteFilename) = mySourceFileID. + ]. + s close. + ] ifFalse:[ + classFilename notNil ifTrue:[ + " + check for overwriting my current source file + this is not allowed, since it would clobber my methods source + file ... you have to save it to some other place. + This happens if you ask for a fileOut into the source-directory + (from which my methods get their source) + " + mySourceFileName := Smalltalk getSourceFileName:classFilename. + sameFile := (filenameString = mySourceFileName). + sameFile ifFalse:[ + mySourceFileName notNil ifTrue:[ + OperatingSystem isUNIXlike ifTrue:[ + sameFile := (filename info id) == (mySourceFileName asFilename info id) + ] + ] + ]. + ] + ]. + ]. + + sameFile ifTrue:[ + ^ FileOutErrorSignal + raiseRequestWith:filenameString + errorString:(' - may not overwrite sourcefile: %1\try again after loading sources in the browser' withCRs bindWith:filenameString) + ]. + + outStream := FileStream newTemporaryIn:filename directory. + outStream fileName accessRights:filename accessRights. + needRename := true + ] ifFalse:[ + "/ another possible trap: if my sourceFileName is + "/ the same as the written one AND the new files directory + "/ is along the sourcePath, we also need a temporary file + "/ first, to avoid accessing the newly written file. + + self instAndClassMethodsDo:[:m | + |mSrc mSrcFilename| + + (anySourceRef isNil and:[(mSrc := m sourceFilename) notNil]) ifTrue:[ + mSrcFilename := mSrc asFilename. + (mSrcFilename baseName = filename baseName + and:[mSrcFilename exists]) ifTrue:[ + anySourceRef := mSrcFilename. + ] ] + ]. + anySourceRef notNil ifTrue:[ + outStream := FileStream newTemporaryIn:filename directory. + outStream fileName accessRights:anySourceRef accessRights. + needRename := true + ] ifFalse:[ + outStream := filename writeStream. + needRename := false ] ]. - anySourceRef ifTrue:[ - newFileName := fileName withSuffix:'new'. - needRename := true - ] ifFalse:[ - newFileName := fileName. - needRename := false - ] + ] on:FileStream openErrorSignal do:[:ex| + ^ FileOutErrorSignal + raiseRequestWith:filename name + errorString:(' - cannot create file:', filename name) ]. - [ - aStream := newFileName writeStream. - ] on:FileStream openErrorSignal do:[:ex| - savFilename notNil ifTrue:[ - savFilename delete - ]. - ^ FileOutErrorSignal - raiseRequestWith:newFileName name - errorString:(' - cannot create file:', newFileName name) - ]. - self fileOutOn:aStream. - aStream close. + self fileOutOn:outStream. + outStream syncData; close. " finally, replace the old-file @@ -2529,11 +2526,15 @@ we have to do a copy ... " needRename ifTrue:[ - newFileName copyTo:fileName. - newFileName delete - ]. - savFilename notNil ifTrue:[ - savFilename delete + fileExists ifTrue:[ + savFilename := filename addSuffix:'.sav~'. + savFilename delete. + filename renameTo:savFilename. + ]. + outStream fileName renameTo:filename. + fileExists ifTrue:[ + savFilename delete. + ]. ]. " @@ -5552,11 +5553,11 @@ !Class class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.626 2013-05-27 08:45:38 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.627 2013-07-04 23:12:52 stefan Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.626 2013-05-27 08:45:38 cg Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.627 2013-07-04 23:12:52 stefan Exp $' ! version_SVN