[Pkg] Rio: File-Test-kph.1.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Thu Nov 13 02:20:09 UTC 2008
A new version of File-Test was added to project Rio:
http://www.squeaksource.com/Rio/File-Test-kph.1.mcz
==================== Summary ====================
Name: File-Test-kph.1
Author: kph
Time: 13 November 2008, 2:20:08 am
UUID: b46f3cbc-3de1-4fb3-9209-fac53df8bc56
Ancestors:
First version of File version of Rio
==================== Snapshot ====================
SystemOrganization addCategory: #'File-Test'!
FileLocalExecutive subclass: #FileVirtualTestFSUnix
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
----- Method: FileVirtualTestFSUnix>>dirClass (in category 'as yet unclassified') -----
dirClass
^ Notification new tag: #dirClass; signal!
----- Method: FileVirtualTestFSUnix>>fileClass (in category 'as yet unclassified') -----
fileClass
^ Notification new tag: #fileClass; signal!
----- Method: FileVirtualTestFSUnix>>initialize (in category 'as yet unclassified') -----
initialize
self initializeDefault!
----- Method: FileVirtualTestFSUnix>>primImagePath (in category 'as yet unclassified') -----
primImagePath
^ '/home/user/bob/squeak/this.image'!
FileLocalDosExecutive subclass: #FileVirtualTestFSDos
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
----- Method: FileVirtualTestFSDos>>dirClass (in category 'as yet unclassified') -----
dirClass
^ Notification new tag: #dirClass; signal!
----- Method: FileVirtualTestFSDos>>fileClass (in category 'as yet unclassified') -----
fileClass
^ Notification new tag: #fileClass; signal!
----- Method: FileVirtualTestFSDos>>initialize (in category 'as yet unclassified') -----
initialize
self initializeDefault!
----- Method: FileVirtualTestFSDos>>primImagePath (in category 'as yet unclassified') -----
primImagePath
^ 'D:\User\Bob\Squeak\this.image'!
TestCase subclass: #FileCaseInsensitiveTest
instanceVariableNames: 'file'
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
----- Method: FileCaseInsensitiveTest>>setUp (in category 'setup') -----
setUp
!
----- Method: FileCaseInsensitiveTest>>tearDown (in category 'setup') -----
tearDown
!
----- Method: FileCaseInsensitiveTest>>testSetOfFiles (in category 'tests') -----
testSetOfFiles
file := Set new.
file
add: ( (File new: 'hello') executive: (FileLocalCaseInsensitiveExecutive new) ).
self assert: file size = 1.
file
add: ((File new: 'heLLo') executive: (FileLocalCaseInsensitiveExecutive new) ).
self assert: file size = 1!
TestCase subclass: #FileDirTest
instanceVariableNames: 'testDir subDir a b c destDir'
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
FileDirTest subclass: #FileArchiveTest
instanceVariableNames: 'archive'
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
!FileArchiveTest commentStamp: 'kph 4/9/2007 02:59' prior: 0!
How to work this archive thing?
In theory, a file ref in an archive should handle copyTo: to actually do the extraction.
How do you get a file ref in an archive?
One option would be:
'myFile.zip' asRio zip entries
Does this mean that on entering zip mode, our rio becomes the top level directory entry in a zipped filesystem?
The filesystem implements select: so all other select dependent facilities should work.
The mode adaptor could just override #executive, probably not sufficient.
----
aDirectory addTree: (anArchive := aFile zip)
anArchive decompress => aDirectory addTree: anArchive
anArchive decompressTo: aDirectory.
aGzipFile decompressTo: aDirectory.!
----- Method: FileArchiveTest>>hmmm (in category 'as yet unclassified') -----
hmmm
"
aDirectory addTree: (anArchive := aFile zip)
anArchive decompress => aDirectory addTree: anArchive
anArchive decompressTo: aDirectory.
aGzipFile decompressTo: aDirectory.
"!
----- Method: FileArchiveTest>>makeArchive (in category 'fixtures') -----
makeArchive
self makeDirectoriesAndFiles.
(archive := destDir mkdir / 'test.zip') zip addTree: testDir; commit.
!
----- Method: FileArchiveTest>>testArchiveAccess (in category 'tests-archive') -----
testArchiveAccess
| file |
self makeArchive.
file := archive zip / 'testing_file/f_1'.
self assert: (file isFile).
!
----- Method: FileArchiveTest>>testArchiveContents (in category 'tests-archive') -----
testArchiveContents
| all |
self makeArchive.
self assert: (archive zip entries asSet = (Set with: (File new: 'testing_file'))).
all := archive zip all entries.
self assert: (all asSet =
{ (File new: 'testing_file').
(File new: 'testing_file/t_a/f 1').
(File new: 'testing_file/t_a/t 1').
(File new: 'testing_file/t_a/t 2'). } asArray asOrderedCollection asSet).
self assert: (all first isDirectory).
self assert: (all second isFile).
!
FileDirTest subclass: #FileDirFtpTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
----- Method: FileDirFtpTest class>>shouldInheritSelectors (in category 'as yet unclassified') -----
shouldInheritSelectors
^ true!
----- Method: FileDirFtpTest>>initialize (in category 'as yet unclassified') -----
initialize
testDir := 'ftp://squeak:viewpoints@squeak.warwick.st/testing_file' asDirectory.
destDir := 'ftp://squeak:viewpoints@squeak.warwick.st/testing_file_dest' asDirectory.!
----- Method: FileDirTest class>>allStandardTests (in category 'as yet unclassified') -----
allStandardTests
^ super allStandardTests , (self suiteWithMethodCategoryMatching: 'tests*')
!
----- Method: FileDirTest class>>resources (in category 'as yet unclassified') -----
resources
self new tearDown.
^ super resources!
----- Method: FileDirTest class>>usesNetwork (in category 'as yet unclassified') -----
usesNetwork
^ self allStandardTests!
----- Method: FileDirTest>>initialize (in category 'fixtures') -----
initialize
testDir := Cwd / 'testing_file'.
destDir := Cwd / 'testing_file_dest'.!
----- Method: FileDirTest>>makeDirectoriesAndFiles (in category 'fixtures') -----
makeDirectoriesAndFiles
subDir := (testDir / 't_a') mkdir.
a := (subDir / 'f 1') contents: 'test file'.
"test dirname with space in it"
b := (subDir / 't 1') mkdir.
c := (subDir / 't 2') mkdir.
!
----- Method: FileDirTest>>setUp (in category 'fixtures') -----
setUp
testDir mkdir!
----- Method: FileDirTest>>tearDown (in category 'fixtures') -----
tearDown
testDir all delete.
destDir all delete.!
----- Method: FileDirTest>>testAddTree (in category 'tests-directory copying') -----
testAddTree
self makeDirectoriesAndFiles.
destDir mkdir addTree: testDir.
self assert: (destDir all entries size = 5).
self assert: ((testDir / 't_a' / 'f 1') contents = 'test file').
self assert: ((destDir / 'testing_file'/ 't_a' / 'f 1') contents = 'test file').!
----- Method: FileDirTest>>testEntries (in category 'tests-select') -----
testEntries
self makeDirectoriesAndFiles.
self assert: subDir entries asSet = {a. b. c.} asSet.
!
----- Method: FileDirTest>>testMakingDirectory (in category 'tests-directory actions') -----
testMakingDirectory
subDir := testDir / 't_a'.
self deny: subDir isDirectory.
subDir mkdir.
self assert: subDir isDirectory!
----- Method: FileDirTest>>testMakingPath (in category 'tests-directory actions') -----
testMakingPath
subDir := testDir / 't_a/t_b/t_c'.
self deny: subDir isDirectory.
self deny: subDir parent isDirectory.
self deny: subDir parent parent isDirectory.
subDir mkpath.
self assert: subDir isDirectory.
self assert: subDir parent isDirectory.
self assert: subDir parent parent isDirectory!
----- Method: FileDirTest>>testRecursiveDirectories (in category 'tests-select') -----
testRecursiveDirectories
| dirs |
self testMakingPath.
subDir := testDir / 't_a'.
dirs := subDir directories.
self assert: dirs first = (testDir / 't_a/t_b').
self assert: dirs size == 1.
dirs := subDir all directories.
self assert: dirs first = (testDir / 't_a/t_b').
self assert: dirs last = (testDir / 't_a/t_b/t_c').
self assert: dirs size == 2.!
----- Method: FileDirTest>>testRemovingDirectory (in category 'tests-directory actions') -----
testRemovingDirectory
self testMakingDirectory.
subDir rmdir.
self deny: subDir isDirectory!
----- Method: FileDirTest>>testRemovingNonExistentDirectory (in category 'tests-directory actions') -----
testRemovingNonExistentDirectory
subDir := testDir / 't_z'.
self deny: subDir isDirectory.
subDir rmdir.
self deny: subDir isDirectory!
TestCase subclass: #FileKernelTest
instanceVariableNames: 'file testDir fileClass dir'
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
----- Method: FileKernelTest class>>allStandardTests (in category 'as yet unclassified') -----
allStandardTests
^ super allStandardTests , (self suiteWithMethodCategoryMatching: 'tests*')
!
----- Method: FileKernelTest>>cleanTestDir (in category 'fixtures') -----
cleanTestDir
testDir ifNotNilDo: [ :d | d all delete ].!
----- Method: FileKernelTest>>fox (in category 'fixtures') -----
fox
^ 'the quick brown fox jumped over the lazy dog' !
----- Method: FileKernelTest>>hello (in category 'fixtures') -----
hello
^ fileClass new: 'hello.txt'!
----- Method: FileKernelTest>>helloV5 (in category 'fixtures') -----
helloV5
^ fileClass new: 'hello.5.txt'!
----- Method: FileKernelTest>>rootIsDirectory (in category 'tests-standard') -----
rootIsDirectory
dir := fileClass new: FileLocalExecutive current root value.
self assert: (dir isRoot).
self assert: (dir isDirectory).
!
----- Method: FileKernelTest>>setUp (in category 'fixtures') -----
setUp
fileClass := FileKernel !
----- Method: FileKernelTest>>tearDown (in category 'fixtures') -----
tearDown
self cleanTestDir!
----- Method: FileKernelTest>>testIsDirectory (in category 'tests-standard') -----
testIsDirectory
self assert: self thisImage parent isDirectory.
self deny: self thisImage parent isFile!
----- Method: FileKernelTest>>testIsFile (in category 'tests-standard') -----
testIsFile
self assert: self thisImage isFile.
self deny: self thisImage isDirectory!
----- Method: FileKernelTest>>testNonEntity (in category 'tests-standard') -----
testNonEntity
self deny: (self thisImage parent / '_blah_') isFile.
self deny: (self thisImage parent / '_blah_') isDirectory!
----- Method: FileKernelTest>>testNonEntityInNonDirectory (in category 'tests-standard') -----
testNonEntityInNonDirectory
self deny: (self thisImage parent / '_blah_' / '_blah_') isFile.
self deny: (self thisImage parent / '_blah_' / '_blah_') isDirectory!
----- Method: FileKernelTest>>thisImage (in category 'fixtures') -----
thisImage
^ fileClass thisImage!
----- Method: FileKernelTest>>useTestDir (in category 'fixtures') -----
useTestDir
^ (testDir := Directory new: '_test_') all delete mkdir!
----- Method: FileKernelTest>>versions (in category 'tests-standard') -----
versions
file := (self useTestDir / self helloV5) touch.
self assert: (file versions asArray = #(5) ).
file nextVersion touch nextVersion touch.
self assert: (file versions asArray = #(5 6 7) ).
self assert: (file latestVersion = '_test_/hello.7.txt').!
FileKernelTest subclass: #FileTest
instanceVariableNames: 'afile newFile'
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
FileTest subclass: #FileModeTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
FileModeTests subclass: #FileGzipTest
instanceVariableNames: 'textFile textFileSize gzipFile gzipFileSize'
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
----- Method: FileGzipTest>>newTextFile (in category 'fixtures') -----
newTextFile
textFile := self useTestDir / 'InflateStream.st'.
textFile delete writer: [ :out |
InflateStream fileOutOn: out moveSource: false toFile: 0.
].
textFileSize := textFile size.
^ textFile!
----- Method: FileGzipTest>>testGzipWriteAndRead (in category 'tests') -----
testGzipWriteAndRead
self assert: (self fox size = 44).
file := (self useTestDir / 'zip.gz') gzip writer: [ :out | out << self fox ].
self assert: (file isFile & file fileSize = 62).
"reading from a gzip file should honour the binary setting of the stream even though the actual on disk file is binary"
self assert: ( file contents = self fox ).
self assert: ( file contents size = 44 ).
!
----- Method: FileGzipTest>>testGzipWriteAndReadBinary (in category 'tests') -----
testGzipWriteAndReadBinary
self assert: (self fox size = 44).
rio := (self useTestDir / 'zip.gz') gzip beBinary writer: [ :out | out << self fox asByteArray ].
self assert: (rio isFile & rio fileSize = 62).
self assert: ( rio beBinary contents = self fox asByteArray ).
self assert: ( rio beBinary contents size = 44 ).!
----- Method: FileGzipTest>>testNewCompressDecompress (in category 'tests') -----
testNewCompressDecompress
"self debug: #testOldCompressDecompress"
| original |
self newTextFile.
textFile gzip compress.
original := textFile rename ext: 'orig'.
(textFile + '.gz') auto decompress.
self assert: (textFile contents = original contents). !
----- Method: FileGzipTest>>testOldCompressDecompress (in category 'tests') -----
testOldCompressDecompress
"self debug: #testOldCompressDecompress"
self newTextFile.
GZipWriteStream compressFile: textFile full asString.
textFile rename ext: 'orig'.
GZipReadStream saveContents: (textFile + '.gz') full asString.
self assert: (textFile contents = (textFile ext: 'orig') contents). !
----- Method: FileModeTests class>>shouldInheritSelectors (in category 'as yet unclassified') -----
shouldInheritSelectors
^ false!
----- Method: FileModeTests>>testBinaryModes (in category 'binary mode') -----
testBinaryModes
rio := self useTestDir / self hello.
self deny: (rio binary == rio).
self assert: (rio beBinary == rio).
!
----- Method: FileModeTests>>testGzipModes (in category 'binary mode') -----
testGzipModes
rio := self useTestDir / self hello.
self deny: (rio gzip == rio).
!
----- Method: FileModeTests>>testRenamingModeFullNameSet (in category 'renaming mode') -----
testRenamingModeFullNameSet
rio := self useTestDir / self hello.
rio touch.
self assert: (rio isFile).
newRio := rio rename fileName: 'goodbye.text'.
self deny: (rio isFile).
self assert: (newRio isFile).!
----- Method: FileModeTests>>testRenamingModes (in category 'renaming mode') -----
testRenamingModes
rio := self useTestDir / self hello.
self deny: (rio rename == rio).
self assert: (rio beRenaming == rio).
!
----- Method: FileTest class>>compiledSize: (in category 'as yet unclassified') -----
compiledSize: categoryMatch
"
self compiledSize: 'Rio-Kernel'. (4881 + 5435) / (11471.0 + 7908.0).
self compiledSize: 'Rio-Grande'. 5435
self compiledSize: 'Files-Directories'. 11471
self compiledSize: 'FileMan-Core'. 7098
"
| total |
total := 0.
(SystemOrganization categoriesMatching: categoryMatch) do: [ :cat |
(SystemOrganization listAtCategoryNamed: cat) do: [ :className |
(Smalltalk at: className) in: [ :class |
class methodsDo: [ :m | total := total + m size ].
class class methodsDo: [ :m | total := total + m size ].
]
].
].
^ total!
----- Method: FileTest class>>shouldInheritSelectors (in category 'as yet unclassified') -----
shouldInheritSelectors
^ true!
----- Method: FileTest>>cwdAppendString (in category 'tests') -----
cwdAppendString
rio := File new.
newRio := rio / 'user'.
self deny: newRio == rio.
self assert: newRio asString = 'user'!
----- Method: FileTest>>equality (in category 'tests') -----
equality
self assert: (File new: '/usr/bin/bob')
= '/usr/bin/bob'.
self assert: (File new: '/usr/bin/bob')
= (File new: '/usr/bin/bob')!
----- Method: FileTest>>exists (in category 'tests') -----
exists
self assert: self thisImage exists.
self assert: self thisImage parent exists.
self deny: (self thisImage / 'blah') exists!
----- Method: FileTest>>ftp (in category 'tests') -----
ftp
file := File new: 'ftp://ftp.seasidehosting.st'.
self assert: file class = Directory.
self assert: file executive class = FileFtpExecutive.!
----- Method: FileTest>>full (in category 'tests') -----
full
dir := Directory new.
self assert: dir full = FileDirectory default pathName.!
----- Method: FileTest>>http (in category 'tests') -----
http
file := File new: 'http://www.google.com'.
self assert: file class = Directory.
self assert: file executive class = FileHttpExecutive!
----- Method: FileTest>>rioClass (in category 'tests') -----
rioClass
^ File!
----- Method: FileTest>>setUp (in category 'fixtures') -----
setUp
fileClass := File !
----- Method: FileTest>>testDirCwd (in category 'tests') -----
testDirCwd
dir := Directory new.
self assert: dir asString = ''!
----- Method: FileTest>>testFileAppendString (in category 'tests') -----
testFileAppendString
self testFileFromString.
newFile := file / 'user'.
self deny: newFile == file.
self assert: newFile = '/home/user'!
----- Method: FileTest>>testFileExt (in category 'tests') -----
testFileExt
file := File new: 'hello.haha.txt'.
self assert: file ext = 'txt'!
----- Method: FileTest>>testFileFromFile (in category 'tests') -----
testFileFromFile
self testFileFromString.
newFile := File new: file.
self assert: newFile = '/home'.
self deny: newFile == file.
self assert: newFile = file!
----- Method: FileTest>>testFileFromString (in category 'tests') -----
testFileFromString
file := File new: '/home'.
self assert: file = '/home'!
----- Method: FileTest>>testFileSetExt (in category 'tests') -----
testFileSetExt
self testFileExt.
file ext: 'bak'.
self assert: file ext = 'bak'.
self assert: file asString = 'hello.haha.bak'!
----- Method: FileTest>>testFull (in category 'tests') -----
testFull
file := File new.
self assert: file full = FileDirectory default pathName.!
----- Method: FileTest>>testLinearRelativeTo (in category 'tests') -----
testLinearRelativeTo
file := '/hello/this/is/a/world/apart/from/here.txt' asFile linearRelativeTo: '/hello/this' asFile.
self assert: (file = 'is/a/world/apart/from/here.txt').!
----- Method: FileTest>>testLinearRelativeToNot (in category 'tests') -----
testLinearRelativeToNot
newFile := (file := '/a/b/c/d/e/f' asFile full) linearRelativeTo: '/no/relation/at/all' asFile.
self assert: (newFile = file).!
----- Method: FileTest>>testRelativeTo (in category 'tests') -----
testRelativeTo
self assert: (('/a/b/c/g/h/i' asFile relativeTo: '/a/b/c/d/e/f') = '../../../g/h/i').
self assert: (('/a/b/c' asFile relativeTo: '/a/b/c') = '').
self assert: (('/a/b/c/d' asFile relativeTo: '/a/b/c') = 'd').
!
----- Method: FileTest>>testRioExtend (in category 'tests') -----
testRioExtend
self testFileFromString.
newFile := file + '.dir'.
self deny: newFile == file.
self assert: newFile = '/home.dir'!
TestCase subclass: #FileKernelUseCases
instanceVariableNames: 'rio newRio'
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
----- Method: FileKernelUseCases>>changesName (in category 'uses-SmalltalkImage') -----
changesName
rio := FileKernel thisImage base: nil version: nil ext: 'changes'.
self
assert: (rio asString
beginsWith: (File thisImage asString allButLast: 5))!
----- Method: FileKernelUseCases>>imageName (in category 'uses-SmalltalkImage') -----
imageName
rio := FileKernel thisImage.
self
assert: (rio asString endsWith: '.image')!
TestCase subclass: #FileStreamsCopyTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
----- Method: FileStreamsCopyTest>>fox (in category 'as yet unclassified') -----
fox
^ 'the quick brown fox jumped over the lazy dog' !
----- Method: FileStreamsCopyTest>>testCopyStreams (in category 'as yet unclassified') -----
testCopyStreams
| in |
in := self fox readStream.
self assert:(self fox = (String streamContents: [ :out |
in copyTo: out.
]))!
----- Method: FileStreamsCopyTest>>testCopyStreamsBinary (in category 'as yet unclassified') -----
testCopyStreamsBinary
| inData in |
in := (inData := self fox asByteArray) readStream.
self assert:(inData = (ByteArray streamContents: [ :out |
in copyTo: out size: inData size withProgress: 'test binary copy'.
]))
!
----- Method: FileStreamsCopyTest>>testCopyStreamsProgressing (in category 'as yet unclassified') -----
testCopyStreamsProgressing
| in |
in := self fox readStream.
self assert:(self fox = (String streamContents: [ :out |
in copyTo: out size: self fox size withProgress: 'test'.
]))!
TestCase subclass: #FileVirtualFSCommonTest
instanceVariableNames: 'file fileClass dirClass'
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
----- Method: FileVirtualFSCommonTest class>>allStandardTests (in category 'as yet unclassified') -----
allStandardTests
^ super allStandardTests , (self suiteWithMethodCategoryMatching: 'tests*')
!
----- Method: FileVirtualFSCommonTest class>>isAbstract (in category 'as yet unclassified') -----
isAbstract
^ self name = #FileVirtualFSCommonTest !
----- Method: FileVirtualFSCommonTest class>>shouldInheritSelectors (in category 'as yet unclassified') -----
shouldInheritSelectors
^ true!
----- Method: FileVirtualFSCommonTest>>currentFileSystem (in category 'fixtures') -----
currentFileSystem
^ FileLocalExecutive current!
----- Method: FileVirtualFSCommonTest>>dirClass (in category 'as yet unclassified') -----
dirClass
^ dirClass!
----- Method: FileVirtualFSCommonTest>>fileClass (in category 'as yet unclassified') -----
fileClass
^ fileClass!
----- Method: FileVirtualFSCommonTest>>hello (in category 'fixtures') -----
hello
^ fileClass new: 'hello.txt'!
----- Method: FileVirtualFSCommonTest>>helloV5 (in category 'fixtures') -----
helloV5
^ 'hello.5.txt' asFile!
----- Method: FileVirtualFSCommonTest>>isKernelTest (in category 'fixtures') -----
isKernelTest
^ fileClass == FileKernel!
----- Method: FileVirtualFSCommonTest>>runCaseWith: (in category 'as yet unclassified') -----
runCaseWith: aBlock
aBlock on: Notification do: [ :ex | ex resume: (self perform: ex tag) ]!
----- Method: FileVirtualFSCommonTest>>stringConcatenation (in category 'tests-string behaviour') -----
stringConcatenation
self assert: ('hello' , (File new: 'world') = 'helloworld').!
----- Method: FileVirtualFSCommonTest>>tearDown (in category 'fixtures') -----
tearDown
FileLocalExecutive testEnd!
----- Method: FileVirtualFSCommonTest>>testBaseGet (in category 'tests-accessing') -----
testBaseGet
self isKernelTest ifTrue: [ ^self ].
self assert: self hello base = 'hello'.
self assert: self fullHello base = 'hello'.
self assert: self helloV5 base = 'hello'.!
----- Method: FileVirtualFSCommonTest>>testBaseSet (in category 'tests-accessing') -----
testBaseSet
self isKernelTest ifTrue: [ ^self ].
self assert: ((self hello base: 'bonjour') = 'bonjour.txt').
self assert: ((self fullHello base: 'bonjour') = (self tmp,'bonjour.txt')).
self assert: ((self helloV5 base: 'bonjour') = 'bonjour.5.txt').!
----- Method: FileVirtualFSCommonTest>>testBaseVersionAndExtSet (in category 'tests-accessing') -----
testBaseVersionAndExtSet
file := self hello base: 'bye' version: nil ext: nil.
self assert: file = 'bye.txt'.
file := self hello base: nil version: 1 ext: nil.
self assert: file = 'hello.1.txt'.
file := self hello base: nil version: nil ext: 'html'.
self assert: file = 'hello.html'.
file := self helloV5 base: 'bye' version: nil ext: nil.
self assert: file = 'bye.5.txt'.
file := self helloV5 base: nil version: 1 ext: nil.
self assert: file = 'hello.1.txt'.
file := self helloV5 base: nil version: nil ext: 'html'.
self assert: file = 'hello.5.html'.
!
----- Method: FileVirtualFSCommonTest>>testDotFirst (in category 'tests-instanciation') -----
testDotFirst
file := '.dotfirst' asFile.
self assert: (file = '.dotfirst').
^ file!
----- Method: FileVirtualFSCommonTest>>testDotLast (in category 'tests-instanciation') -----
testDotLast
file := 'dotlast.' asFile.
self assert: (file = 'dotlast.').
^ file!
----- Method: FileVirtualFSCommonTest>>testExtGet (in category 'tests-accessing') -----
testExtGet
self isKernelTest ifTrue: [ ^self ].
self assert: self hello ext = 'txt'.
self assert: self fullHello ext = 'txt'.
self assert: self helloV5 ext = 'txt'.
!
----- Method: FileVirtualFSCommonTest>>testExtSet (in category 'tests-accessing') -----
testExtSet
self isKernelTest ifTrue: [ ^self ].
self assert: ((self hello ext: 'html') asString = 'hello.html').
self assert: ((self helloV5 ext: 'html') asString = 'hello.5.html').
self assert: ((self fullHello ext: 'html') asString = (self tmp,'hello.html')).
!
----- Method: FileVirtualFSCommonTest>>testFileNameGet (in category 'tests-accessing') -----
testFileNameGet
self assert: self hello fileName = 'hello.txt'.
self assert: self fullHello fileName = 'hello.txt'.
self assert: self helloV5 fileName = 'hello.5.txt'!
----- Method: FileVirtualFSCommonTest>>testFileNameSet (in category 'tests-accessing') -----
testFileNameSet
self isKernelTest ifTrue: [ ^self ].
self assert: ((self hello fileName: 'bonjour.text') = 'bonjour.text').
self assert: ((self fullHello fileName: 'bonjour.text') = (self tmp,'bonjour.text')).
!
----- Method: FileVirtualFSCommonTest>>testSplitToBaseVersionAndExt (in category 'tests-accessing') -----
testSplitToBaseVersionAndExt
self hello splitToBaseVersionAndExt: [ :b :v :e |
self assert: (b = 'hello').
self assert: (v = 0).
self assert: (e = 'txt').
].
self fullHello splitToBaseVersionAndExt: [ :b :v :e |
self assert: (b = 'hello').
self assert: (v = 0).
self assert: (e = 'txt').
].
self helloV5 splitToBaseVersionAndExt: [ :b :v :e |
self assert: (b = 'hello').
self assert: (v = 5).
self assert: (e = 'txt').
].
self testDotFirst splitToBaseVersionAndExt: [ :b :v :e |
self assert: (b = '.dotfirst').
self assert: (v = 0).
self assert: (e = '').
].
self testDotLast splitToBaseVersionAndExt: [ :b :v :e |
self assert: (b = 'dotlast.').
self assert: (v = 0).
self assert: (e = '').
].!
----- Method: FileVirtualFSCommonTest>>testVersionGet (in category 'tests-accessing') -----
testVersionGet
self isKernelTest ifTrue: [ ^self ].
self assert: (self hello version = 0).
self assert: (self fullHello version = 0).
self assert: (self helloV5 version = 5).!
----- Method: FileVirtualFSCommonTest>>testVersionSet (in category 'tests-accessing') -----
testVersionSet
self isKernelTest ifTrue: [ ^self ].
self assert: ((self hello version: 2) = 'hello.2.txt').
self assert: ((self fullHello version: 3) = (self tmp,'hello.3.txt')).
self assert: ((self helloV5 version: 6) = 'hello.6.txt').!
FileVirtualFSCommonTest subclass: #FileVirtualFSDosKernelTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
FileVirtualFSDosKernelTest subclass: #FileVirtualFSDosFileTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
----- Method: FileVirtualFSDosFileTest>>setUp (in category 'fixture') -----
setUp
fileClass := File.
dirClass := Directory.
FileLocalExecutive testFileSystem: FileVirtualTestFSDos new.
!
----- Method: FileVirtualFSDosFileTest>>testLinearRelativeTo (in category 'tests') -----
testLinearRelativeTo
file := fileClass new: 'E:\hello\this\is\a\world\apart\from\here.txt'.
file := file linearRelativeTo: (fileClass new: 'E:\hello\this').
self assert: (file = 'is\a\world\apart\from\here.txt').
!
----- Method: FileVirtualFSDosFileTest>>testLinearRelativeToWrongFS (in category 'tests') -----
testLinearRelativeToWrongFS
self should: [ (fileClass new: 'E:\hello\here.txt') linearRelativeTo: (theClass new: 'F:\hello')] raise: Error.
!
----- Method: FileVirtualFSDosFileTest>>testMkpathForNonExistentVolume (in category 'tests') -----
testMkpathForNonExistentVolume
self flag: #toDo.!
----- Method: FileVirtualFSDosFileTest>>testSplit (in category 'tests') -----
testSplit
"self assert: ('/aa/bb/cc' asFile split = #('' 'aa' 'bb' 'cc'))."
self assert: ('aa/bb/cc' asFile split = #('aa' 'bb' 'cc')).
self assert: ('' asFile split = #()).
self assert: ('C:\aa\bb\cc' asFile split = #('C:\' 'aa' 'bb' 'cc')) .
self assert: ('aa/bb/cc' asFile full split = #('D:\' 'User' 'Bob' 'Squeak' 'aa' 'bb' 'cc')).!
----- Method: FileVirtualFSDosFileTest>>tmp (in category 'fixture') -----
tmp
^ 'D:\tmp\'!
----- Method: FileVirtualFSDosKernelTest>>fullHello (in category 'fixture') -----
fullHello
^ fileClass new: 'D:\tmp\hello.txt'!
----- Method: FileVirtualFSDosKernelTest>>setUp (in category 'fixture') -----
setUp
fileClass := dirClass := FileKernel.
FileLocalExecutive testFileSystem: FileVirtualTestFSDos new.
!
----- Method: FileVirtualFSDosKernelTest>>testInstantiateDrive (in category 'tests') -----
testInstantiateDrive
"instanciating on drive gives rio on the root directory for that volume"
file := fileClass new: 'C:'.
self assert: (file = 'C:\').
self assert: (file isRoot).!
----- Method: FileVirtualFSDosKernelTest>>testInstantiateRoot (in category 'tests') -----
testInstantiateRoot
file := fileClass new: 'C:\'.
self assert: (file = 'C:\').
self assert: (file isRoot).!
----- Method: FileVirtualFSDosKernelTest>>testParent (in category 'tests') -----
testParent
"note that the parent of root is the file system 'executive' "
self assert: ((fileClass new: 'C:\a\b') parent = 'C:\a').
self assert: ((fileClass new: 'C:\a') parent = 'C:\').
self assert: ((fileClass new: 'C:\') parent class = FileVirtualTestFSDos).!
----- Method: FileVirtualFSDosKernelTest>>testVerifyDefaultDirectory (in category 'tests') -----
testVerifyDefaultDirectory
file := self currentFileSystem defaultDirectory.
self assert: (file class = dirClass).
self assert: file asString = 'D:\User\Bob\Squeak'.!
----- Method: FileVirtualFSDosKernelTest>>thisImage (in category 'tests') -----
thisImage
| i |
i := fileClass thisImage.
self assert: (i = 'D:\User\Bob\Squeak\this.image').
^ i !
FileVirtualFSCommonTest subclass: #FileVirtualFSUnixKernelTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
FileVirtualFSUnixKernelTest subclass: #FileVirtualFSUnixFileTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Test'!
----- Method: FileVirtualFSUnixFileTest>>linearRelativeTo (in category 'tests') -----
linearRelativeTo
rio := (File new: '/hello/this/is/a/world/apart/from/here.txt')
linearRelativeTo: (File new: '/hello/this').
self assert: (rio = 'is/a/world/apart/from/here.txt').!
----- Method: FileVirtualFSUnixFileTest>>setUp (in category 'fixture') -----
setUp
fileClass := File.
dirClass := Directory.
FileLocalExecutive testFileSystem: FileVirtualTestFSUnix new.
!
----- Method: FileVirtualFSUnixFileTest>>split (in category 'tests') -----
split
self assert: ((fileClass new: '/aa/bb/cc') split = #('/' 'aa' 'bb' 'cc')).
self assert: ((fileClass new: 'aa/bb/cc') split = #('aa' 'bb' 'cc')).
self assert: ((fileClass new: '') split = #()).
!
----- Method: FileVirtualFSUnixFileTest>>tmp (in category 'fixture') -----
tmp
^ '/tmp/'!
----- Method: FileVirtualFSUnixKernelTest>>fullHello (in category 'fixture') -----
fullHello
^ fileClass new: '/tmp/hello.txt'!
----- Method: FileVirtualFSUnixKernelTest>>instantiateRoot (in category 'tests') -----
instantiateRoot
file := fileClass new: '/'.
self assert: (file = '/').
self assert: (file isRoot).
!
----- Method: FileVirtualFSUnixKernelTest>>parent (in category 'tests') -----
parent
"note that the parent of root is the file system 'executive' "
self assert: ((fileClass new: '/a/b') parent = '/a').
self assert: ((fileClass new: '/a') parent = '/').
self assert: ((fileClass new: '/') parent class = FileVirtualTestFSUnix).!
----- Method: FileVirtualFSUnixKernelTest>>root (in category 'tests') -----
root
!
----- Method: FileVirtualFSUnixKernelTest>>setUp (in category 'fixture') -----
setUp
fileClass := dirClass := FileKernel.
FileLocalExecutive testFileSystem: FileVirtualTestFSUnix new.
!
----- Method: FileVirtualFSUnixKernelTest>>thisImage (in category 'tests') -----
thisImage
| i |
i := fileClass thisImage.
self assert: (i = '/home/user/bob/squeak/this.image').
^ i !
----- Method: FileVirtualFSUnixKernelTest>>verifyDefaultDirectory (in category 'tests') -----
verifyDefaultDirectory
file := self currentFileSystem defaultDirectory.
self assert: (file class = dirClass).
self assert: file asString = '/home/user/bob/squeak'.!
More information about the Packages
mailing list