[PATCH] Give correct names to VFS objects

So that filing in from a VFS file does not show the temporary filenames.
  A very nice side effect of .star files is that `make check' tests VFS,
which brought the bogosity fixed in the previous patch to my attention.

This is 3.0 only, of course.

Paolo

2007-07-01  Paolo Bonzini  <[hidden email]>

        * kernel/File.st: Use VFSHandler>>#fullName.
        * kernel/FileDescr.st: Add #setName:.
        * kernel/VFS.st: Add fsName field to ArchiveFileHandler, replacing
        command in ExternalArchiveFileHandler and making #vfsFor:name:
        concrete in ArchiveFileHandler.  Add #fullName, implement it
        in ArchiveMemberHandler.  Use #setName: when opening files.

* looking for [hidden email]--2004b/smalltalk--devo--2.2--patch-428 to compare with
* comparing to [hidden email]--2004b/smalltalk--devo--2.2--patch-428
M  kernel/File.st
M  kernel/FileDescr.st
M  kernel/VFS.st

* modified files

--- orig/kernel/File.st
+++ mod/kernel/File.st
@@ -332,7 +332,7 @@ displayOn: aStream
 
 name
     "Answer the name of the file identified by the receiver"
-    ^vfsHandler name
+    ^vfsHandler fullName
 !
 
 size


--- orig/kernel/FileDescr.st
+++ mod/kernel/FileDescr.st
@@ -596,6 +596,10 @@ checkIfPipe
     'cannot do that to a pipe or socket.' ]
 !
 
+setName: aString
+    name := aString.
+!
+
 setFD: fd
     access := 3.
     file := fd.


--- orig/kernel/VFS.st
+++ mod/kernel/VFS.st
@@ -71,7 +71,7 @@ virtual filesystems that take a file tha
 command on it, and then read from the result.'!
 
 RealFileHandler subclass: #ArchiveFileHandler
-       instanceVariableNames: 'handlers'
+       instanceVariableNames: 'handlers fsName'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Streams-Files'
@@ -89,7 +89,7 @@ will still ask the archive to get direct
 on them, to extract them to a real file, and so on.'!
 
 ArchiveFileHandler subclass: #ExternalArchiveFileHandler
-       instanceVariableNames: 'command topLevelFiles allFiles extractedFiles'
+       instanceVariableNames: 'topLevelFiles allFiles extractedFiles'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Streams-Files'
@@ -288,6 +288,12 @@ finalize
 
 !VFSHandler methodsFor: 'accessing'!
 
+fullName
+    "Answer the name of the file identified by the receiver as answered by
+     File>>#name."
+    ^self name
+!
+
 name
     "Answer the name of the file identified by the receiver"
     ^name
@@ -690,18 +696,18 @@ vfsFor: file name: fsName subPath: subPa
     command := self fileTypes at: fsName.
     temp := FileStream openTemporaryFile: Directory temporary, '/vfs'.
     Smalltalk system: (command % { file. temp name }).
-    ^self new name: file realFileName: temp name! !
+    ^self new name: file fsName: fsName realFileName: temp name! !
 
 
 !DecodedFileHandler methodsFor: 'files'!
 
-name: virtualFileName realFileName: temporaryFileName
+name: virtualFileName fsName: aString realFileName: temporaryFileName
     "Private - Initialize a new object storing the contents of the
      virtualFileName file into temporaryFileName."
     VFSHandler addDependent: self.
     self addToBeFinalized.
-    self name: virtualFileName.
-    realFileName := File fullNamFor: temporaryFileName!
+    self name: virtualFileName, '#', aString.
+    realFileName := File fullNameFor: temporaryFileName!
 
 realFileName
     "Answer the real file name which holds the file contents,
@@ -719,19 +725,13 @@ release
     super release! !
 
 
-!ArchiveFileHandler class methodsFor: 'private'!
-
-activePaths
-    "Answer a dictionary that stores the currently opened archive file
-     members, to avoid extracting members multiple times.  Might be
-     worthwhile to push it to the superclass."
-    activePaths isNil ifTrue: [ activePaths := WeakValueLookupTable new ].
-    ^activePaths!
+!ArchiveFileHandler class methodsFor: 'instance creation'!
 
 vfsFor: file name: fsName
-    "Create a temporary file and use it to construct the contents of the given
+    "Create an instance of this class representing the contents of the given
      file, under the virtual filesystem fsName."
-    self subclassResponsibility!
+    ^self new
+ name: file fsName: fsName!
 
 vfsFor: file name: fsName subPath: subPath
     "Create a temporary file and use it to construct the contents of the given
@@ -740,7 +740,24 @@ vfsFor: file name: fsName subPath: subPa
  ifFalse: [ ^(self vfsFor: file name: fsName subPath: nil) at: subPath ].
 
     ^self activePaths at: (fsName -> file) ifAbsentPut: [
- self vfsFor: file name: fsName ]!
+ self vfsFor: file name: fsName ]! !
+
+!ArchiveFileHandler methodsFor: 'accessing'!
+
+name
+    ^super name, '#', self fsName!
+
+fsName
+    ^fsName! !
+
+!ArchiveFileHandler class methodsFor: 'private'!
+
+activePaths
+    "Answer a dictionary that stores the currently opened archive file
+     members, to avoid extracting members multiple times.  Might be
+     worthwhile to push it to the superclass."
+    activePaths isNil ifTrue: [ activePaths := WeakValueLookupTable new ].
+    ^activePaths!
 
 release
     activePaths := nil.
@@ -837,6 +854,11 @@ updateMember: anArchiveMemberHandler
 
     self subclassResponsibility! !
 
+!ArchiveFileHandler methodsFor: 'private'!
+
+name: containerFileName fsName: aString
+    super name: containerFileName.
+    fsName := aString! !
 
 !ExternalArchiveFileHandler class methodsFor: 'registering'!
 
@@ -868,24 +890,20 @@ fileSystemsIn: path
     ifTrue: [ fileTypes at: each put: path, '/', each ]
     ]!
 
+fileTypes
+    ^fileTypes!
+
 release
     "Avoid that paths stay in the image file"
     fileTypes := nil.
-    super release!
-
-vfsFor: file name: fsName
-    "Create a temporary file and use it to construct the contents of the given
-     file, under the virtual filesystem fsName."
-    ^self new
- name: file;
- command: (fileTypes at: fsName)! !
+    super release! !
 
 !ExternalArchiveFileHandler methodsFor: 'members'!
 
 createDir: dirName
     "Create a subdirectory of the receiver, naming it dirName."
 
-    Smalltalk system: ('%1 mkdir %2 %3' % { command. self name. dirName })!
+    Smalltalk system: ('%1 mkdir %2 %3' % { self command. self realFileName. dirName })!
 
 do: aBlock
     "Evaluate aBlock once for each file in the directory represented by the
@@ -906,7 +924,7 @@ extractMember: anArchiveMemberHandler
  | temp |
         temp := FileStream openTemporaryFile: Directory temporary, '/vfs'.
         Smalltalk system: ('%1 copyout %2 %3 %4'
-    % { command. self name. anArchiveMemberHandler name. temp name }).
+    % { self command. self realFileName. anArchiveMemberHandler name. temp name }).
 
         File fullNameFor: temp name
     ]!
@@ -954,7 +972,7 @@ removeMember: anArchiveMemberHandler
  ifFalse: [ 'rm' ].
 
     Smalltalk system: ('%1 %2 %3 %4'
- % { command. subcmd. self name. anArchiveMemberHandler name. })!
+ % { self command. subcmd. self realFileName. anArchiveMemberHandler name. })!
 
 updateMember: anArchiveMemberHandler
     "Update the member represented by anArchiveMemberHandler by
@@ -962,9 +980,13 @@ updateMember: anArchiveMemberHandler
      archive."
 
     Smalltalk system: ('%1 copyin %2 %3 %4'
- % { command. self name. anArchiveMemberHandler name.
+ % { self command. self realFileName. anArchiveMemberHandler name.
     anArchiveMemberHandler realFileName })!
 
+command
+    ^self class fileTypes at: fsName
+!
+
 refresh
     "Extract the directory listing from the archive"
 
@@ -976,7 +998,7 @@ refresh
     allFiles := LookupTable new.
     directoryTree := LookupTable new.
     pipe := FileStream
- popen: command, ' list ', self name
+ popen: self command, ' list ', self realFileName
  dir: FileStream read.
     pipe linesDo: [ :l || line |
  line := l readStream.
@@ -1033,9 +1055,6 @@ refresh
 
 !ExternalArchiveFileHandler methodsFor: 'private'!
 
-command: cmd
-    command := cmd!
-
 findDirectory: path into: tree
     "Look up into tree (which is a tree of Dictionaries) the directory
      that is the parent of the file named `path'."
@@ -1096,6 +1115,20 @@ size: bytes stCtime: ctime stMtime: mtim
 
 !ArchiveMemberHandler methodsFor: 'accessing'!
 
+realFileName
+    "Answer the real file name which holds the file contents,
+     or nil if it does not apply."
+
+    realFileName isNil ifFalse: [ ^realFileName ].
+    self exists ifFalse: [ ^nil ].
+    realFileName := (self parent extractMember: self).
+    ^realFileName!
+
+fullName
+    "Answer the name of the file identified by the receiver as answered by
+     File>>#name."
+    ^Directory append: self name to: self parent name!
+
 parent
     "Answer the archive of which the receiver is a member."
 
@@ -1180,15 +1213,6 @@ isAccessible
 
 !ArchiveMemberHandler methodsFor: 'finalization'!
 
-realFileName
-    "Answer the real file name which holds the file contents,
-     or nil if it does not apply."
-
-    realFileName isNil ifFalse: [ ^realFileName ].
-    self exists ifFalse: [ ^nil ].
-    realFileName := (self parent extractMember: self).
-    ^realFileName!
-
 release
     "Release the resources used by the receiver that don't survive when
      reloading a snapshot."
@@ -1216,6 +1240,7 @@ open: class mode: mode ifFail: aBlock
     mode == FileStream read ifFalse: [
  fileStream addDependent: self ].
 
+    fileStream setName: self name.
     ^fileStream
 !
 



_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk