[PATCH 1/7] kernel: Add primitives for link, fsync, fdatasync and sync and expose them

2013-08-09  Holger Hans Peter Freyther  <[hidden email]>

        * kernel/FilePath.st: Add FilePath>>#linkAs: and FilePath>>#linkFrom:
        selectors.
        * kernel/File.st: Add File class>>#sync, File class>>#primFsync:,
        File class>>#primFdatasync, File class>>#link:as:, File class>>#link:from:,
        File>>#primLink:as:, File>>#linkFrom:, File>>#linkAs: selectors.
        * kernel/FileDescr.st: Add >>#fsync and >>#fdatasync selectors.
        * kernel/FileStream.st: Override >>#fsync and >>#fdatasync selectors.

2013-08-09  Holger Hans Peter Freyther  <[hidden email]>

        * libgst/cint.c: Bind link, fsync, fdatasync and sync for
        additional C level access.
---
 ChangeLog            | 10 ++++++++++
 configure.ac         |  2 +-
 kernel/File.st       | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 kernel/FileDescr.st  | 11 +++++++++++
 kernel/FilePath.st   | 13 +++++++++++++
 kernel/FileStream.st | 12 ++++++++++++
 libgst/ChangeLog     |  5 +++++
 libgst/cint.c        |  8 ++++++++
 8 files changed, 112 insertions(+), 1 deletion(-)

diff --git a/ChangeLog b/ChangeLog
index d4c410f..e5b85a6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2013-08-09  Holger Hans Peter Freyther  <[hidden email]>
+
+ * kernel/FilePath.st: Add FilePath>>#linkAs: and FilePath>>#linkFrom:
+ selectors.
+ * kernel/File.st: Add File class>>#sync, File class>>#primFsync:,
+ File class>>#primFdatasync, File class>>#link:as:, File class>>#link:from:,
+ File>>#primLink:as:, File>>#linkFrom:, File>>#linkAs: selectors.
+ * kernel/FileDescr.st: Add >>#fsync and >>#fdatasync selectors.
+ * kernel/FileStream.st: Override >>#fsync and >>#fdatasync selectors.
+
 2013-08-10  Gwenael Casaccio <[hidden email]>
 
  * kernel/BlkClosure.st: Add >>#method: setter.
diff --git a/configure.ac b/configure.ac
index e53b6c2..57f40b4 100644
--- a/configure.ac
+++ b/configure.ac
@@ -359,7 +359,7 @@ AC_REPLACE_FUNCS(putenv strdup strerror strsignal mkstemp getpagesize \
         lrint trunc strsep strpbrk symlink mkdtemp)
 AC_CHECK_FUNCS_ONCE(gethostname memcpy memmove sighold uname usleep lstat \
  grantpt popen getrusage gettimeofday fork strchr utimes utime readlink \
- sigsetmask alarm select mprotect madvise waitpid accept4 \
+ sigsetmask alarm select mprotect madvise waitpid accept4 fdatasync \
  setsid spawnl pread pwrite _NSGetExecutablePath _NSGetEnviron \
  chown getgrnam getpwnam endgrent endpwent setgroupent setpassent)
 
diff --git a/kernel/File.st b/kernel/File.st
index 426a415..fa34763 100644
--- a/kernel/File.st
+++ b/kernel/File.st
@@ -119,6 +119,20 @@ FilePath subclass: File [
  (self path: fileName) touch
     ]
 
+    File class >> link: srcName as: destName [
+        "Create a hard link for the srcName file with the given path name"
+
+        <category: 'file operations'>
+        (self path: srcName) linkAs: destName
+    ]
+
+    File class >> link: destName from: srcName [
+        "Create a hard link named destName file from the given path"
+
+        <category: 'file operations'>
+        (self path: destName) linkFrom: srcName
+    ]
+
     File class >> symlink: srcName as: destName [
  "Create a symlink for the srcName file with the given path name"
 
@@ -197,6 +211,24 @@ FilePath subclass: File [
  ^self path: ImageFileName
     ]
 
+    File class >> primFsync: aFd [
+        <category: 'private-C call-outs'>
+        <cCall: 'fsync' returning: #int args: #(#int)>
+    ]
+
+    File class >> primFdatasync: aFd [
+        <category: 'private-C call-outs'>
+        "Depending on the version of the libc this might fail with a primitive
+        error. In that case primFsync should be called."
+        <cCall: 'fdatasync' returning: #int args: #(#int)>
+    ]
+
+    File class >> sync [
+        <category: 'C call-outs'>
+        "Blocking call to the kernel to sync all files to storage"
+        <cCall: 'sync' returning: #int args: #()>
+    ]
+
     = aFile [
  "Answer whether the receiver represents the same file as the receiver."
 
@@ -259,6 +291,11 @@ FilePath subclass: File [
 
     ]
 
+    primLink: srcName as: destName [
+        <category: 'private-C call-outs'>
+        <cCall: 'link' returning: #int args: #(#string #string)>
+    ]
+
     primSymlink: srcName as: destName [
  <category: 'private-C call-outs'>
  <cCall: 'symlink' returning: #int args: #(#string #string)>
@@ -526,6 +563,14 @@ FilePath subclass: File [
  result < 0 ifTrue: [ File checkError ]
     ]
 
+    linkFrom: srcName [
+        "Create the receiver as hard link from path destName"
+
+        <category: 'file operations'>
+        (self primLink: srcName as: self asString) < 0
+            ifTrue: [ File checkError ]
+    ]
+
     symlinkFrom: srcName [
  "Create the receiver as a symlink from path destName"
 
@@ -592,6 +637,13 @@ FilePath subclass: File [
  File checkError.
     ]
 
+    linkAs: destName [
+        "Create destName as a symbolic link of the receiver."
+
+        <category: 'file operations'>
+        (self class path: destName) linkFrom: self asString.
+    ]
+
     symlinkAs: destName [
  "Create destName as a symbolic link of the receiver.  The appropriate
  relative path is computed automatically."
diff --git a/kernel/FileDescr.st b/kernel/FileDescr.st
index 3dc8d01..2896d89 100644
--- a/kernel/FileDescr.st
+++ b/kernel/FileDescr.st
@@ -1104,5 +1104,16 @@ do arbitrary processing on the files.'>
  ^true
     ]
 
+    fsync [
+        <category: 'primitive'>
+        (File primFsync: fd) < 0
+            ifTrue: [self checkError]
+    ]
+
+    fdatasync [
+        <category: 'primitive'>
+        (File primFdatasync: fd) < 0
+            ifTrue: [self checkError]
+    ]
 ]
 
diff --git a/kernel/FilePath.st b/kernel/FilePath.st
index 8575c0b..84aae3e 100644
--- a/kernel/FilePath.st
+++ b/kernel/FilePath.st
@@ -688,6 +688,12 @@ size and timestamps.'>
  ^self open: FileStream write
     ]
 
+    linkAs: destName [
+        "Create destName as a hard link of the receiver."
+        <category: 'file operations'>
+        self subclassResponsibility
+    ]
+
     symlinkAs: destName [
  "Create destName as a symbolic link of the receiver.  The appropriate
  relative path is computed automatically."
@@ -703,6 +709,13 @@ size and timestamps.'>
  self subclassResponsibility
     ]
 
+    linkFrom: srcName [
+        "Create the receiver as a hard link from srcName."
+
+        <category: 'file operations'>
+        self subclassResponsibility
+    ]
+
     symlinkFrom: srcName [
  "Create the receiver as a symbolic link from srcName (relative to the
  path of the receiver)."
diff --git a/kernel/FileStream.st b/kernel/FileStream.st
index 1aa5635..780feff 100644
--- a/kernel/FileStream.st
+++ b/kernel/FileStream.st
@@ -659,6 +659,18 @@ file object, such as /dev/rmt0 on UNIX or MTA0: on VMS).'>
     into: collection
     startingAt: endPtr + 1)
     ]
+
+    fsync [
+        <category: 'primitive'>
+        self flush.
+        ^super fsync
+    ]
+
+    fdatasync [
+        <category: 'primitive'>
+        self flush.
+        ^super fdatasync
+    ]
 ]
 
 
diff --git a/libgst/ChangeLog b/libgst/ChangeLog
index e1c5d9d..c3bee00 100644
--- a/libgst/ChangeLog
+++ b/libgst/ChangeLog
@@ -1,3 +1,8 @@
+2013-08-09  Holger Hans Peter Freyther  <[hidden email]>
+
+ * libgst/cint.c: Bind link, fsync, fdatasync and sync for
+ additional C level access.
+
 2013-08-10  Gwenael Casaccio <[hidden email]>
 
  * comp.c: Add arguments and temporaries name in DebugInformation.
diff --git a/libgst/cint.c b/libgst/cint.c
index 77c8f8c..9dd441e 100644
--- a/libgst/cint.c
+++ b/libgst/cint.c
@@ -641,6 +641,7 @@ _gst_init_cfuncs (void)
   _gst_define_cfunc ("rewinddir", rewinddir);
   _gst_define_cfunc ("extractDirentName", extract_dirent_name);
 
+  _gst_define_cfunc ("link", link);
   _gst_define_cfunc ("symlink", my_symlink);
   _gst_define_cfunc ("unlink", unlink);
   _gst_define_cfunc ("rename", rename);
@@ -649,6 +650,13 @@ _gst_init_cfuncs (void)
   _gst_define_cfunc ("mkdir", my_mkdir);
   _gst_define_cfunc ("mkdtemp", my_mkdtemp);
   _gst_define_cfunc ("getCurDirName", _gst_get_cur_dir_name);
+  _gst_define_cfunc ("fsync", fsync);
+#ifdef HAVE_FDATASYNC
+  _gst_define_cfunc ("fdatasync", fdatasync);
+#else
+  _gst_define_cfunc ("fdatasync", fsync);
+#endif
+  _gst_define_cfunc ("sync", sync);
 
   _gst_define_cfunc ("fileIsReadable", _gst_file_is_readable);
   _gst_define_cfunc ("fileIsWriteable", _gst_file_is_writeable);
--
1.8.3.2


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

The parsing code of Convert.st has been copied into the STTools
package. Start using the new package in the Convert scripts.

2013-08-10  Holger Hans Peter Freyther  <[hidden email]>

        * scripts/Convert.st: Use the STTools tools instead of the
        current code.
---
 ChangeLog          |   5 +
 scripts/Convert.st | 326 +----------------------------------------------------
 2 files changed, 7 insertions(+), 324 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index e5b85a6..95ff619 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2013-08-10  Holger Hans Peter Freyther  <[hidden email]>
+
+ * scripts/Convert.st: Use the STTools tools instead of the
+ current code.
+
 2013-08-09  Holger Hans Peter Freyther  <[hidden email]>
 
  * kernel/FilePath.st: Add FilePath>>#linkAs: and FilePath>>#linkFrom:
diff --git a/scripts/Convert.st b/scripts/Convert.st
index a02b3b6..a7a402e 100644
--- a/scripts/Convert.st
+++ b/scripts/Convert.st
@@ -30,7 +30,7 @@
 |
  ======================================================================"
 
-PackageLoader fileInPackage: #Parser.
+PackageLoader fileInPackage: #STTools.
 
 STInST.OldSyntaxExporter class extend [
     emitEval: aBlock to: aStream for: namespace [
@@ -63,328 +63,6 @@ STInST.NewSyntaxExporter class extend [
     ]
 ]
 
-
-Object subclass: EmittedEntity [  
-    emitTo: aStream filteredBy: aBlock [
-        self subclassResponsibility
-    ]
-]
-
-EmittedEntity subclass: EmittedComments [
-    | comments |
-    EmittedComments class >> comments: aCollection source: aString [
- ^self new comments: (aCollection collect: [ :c |
-    aString copyFrom: c first to: c last ])
-    ]
-
-    emitTo: outStream filteredBy: aBlock [
- comments do: [ :c |
- STInST.FileOutExporter defaultExporter fileOutComment: c to: outStream.
- outStream nl; nl]
-    ]
-
-    comments: anArray [
- comments := anArray
-   ]
-]
-
-EmittedEntity subclass: EmittedClass [
-    | class methodsToEmit classMethodsToEmit isComplete |
-    
-    <comment: 'This class is responsible for emitting a class
-    by using a FormattingExporter.'>
-    
-    EmittedClass class >> forClass: aClass [        
- (aClass superclass notNil and: [
-    aClass superclass isDefined not ]) ifTrue: [
-        Warning signal:
-    ('superclass %1 is undefined' % {aClass superclass}) ].
-        ^super new initializeWithClass: aClass complete: true
-    ]
-    
-    EmittedClass class >> forExtension: aClass [
- aClass isDefined ifFalse: [
-    Warning signal:
- ('extensions for undefined class %1' % {aClass}) ].
-        ^super new initializeWithClass: aClass complete: false
-    ]
-    
-    initializeWithClass: aClass complete: aBoolean [
-        class := aClass.
-        methodsToEmit := STInST.OrderedSet new.
- classMethodsToEmit := STInST.OrderedSet new.
- isComplete := aBoolean
-    ]
-
-    forClass [
-        ^class
-    ]
-    
-    addMethod: aMethod [
-        methodsToEmit add: aMethod selector asSymbol.
-    ]
-
-    addClassMethod: aMethod [
- classMethodsToEmit add: aMethod selector asSymbol.
-    ]
-
-    emitTo: aStream filteredBy: aBlock [
- (aBlock value: class)
-    ifFalse: [
-        Notification signal: ('Skipping %1' % {class}).
- ^self ].
-
-        Notification signal: ('Converting %1...' % {class}).
-        (STInST.FileOutExporter defaultExporter on: class to: aStream)
-            completeFileOut: isComplete;
-            fileOutSelectors: methodsToEmit classSelectors: classMethodsToEmit.
-    ]
-]
-
-EmittedEntity subclass: EmittedEval [
-    | statements comments namespace |
-    
-    <comment: 'This class is responsible for emitting a set of
-    statements that should be inside an Eval declaration.'>
-    
-    EmittedEval class >> new [
-        ^super new initialize
-    ]
-    
-    initialize [
-        statements := OrderedCollection new
-    ]
-    
-    namespace [
- ^namespace
-    ]
-
-    namespace: aNamespace [
- namespace := aNamespace
-    ]
-
-    addStatement: aStatement [
-        statements add: aStatement
-    ]
-    
-    emitTo: aStream filteredBy: aBlock [
- statements isEmpty ifTrue: [ ^self ].
- STInST.FileOutExporter defaultExporter
-    emitEval: [
- | formatter |
- formatter := STInST.RBFormatter new.
- formatter indent: 1 while: [
-    formatter indent.
-            aStream nextPutAll: (formatter formatAll: statements) ]]
-    to: aStream
-    for: namespace.
-    ]
-]
-
-
-
-STInST.STClassLoader subclass: SyntaxConverter [
-    | stuffToEmit classesToEmit createdNamespaces filter outStream rewriter |
-    
-    <comment: 'A class loader that creates a set of "EmittedEntity"
-    based on the contents of the given file being loaded.
-    When the contents of the file are loaded, the responsibilty of
-    emitting code using the new syntax belongs to those various
-    entities that have been constructed.'>
-    
-    
-    SyntaxConverter class >> convertSqueakStream: in to: out [
-        <category: 'instance creation'>
-        ^self convertStream: in with: STInST.SqueakFileInParser to: out
-    ]
-    
-    SyntaxConverter class >> convertSIFStream: in to: out [
-        <category: 'instance creation'>
-        ^self convertStream: in with: STInST.SIFFileInParser to: out
-    ]
-    
-    SyntaxConverter class >> convertStream: in to: out [
-        <category: 'instance creation'>
-        ^self convertStream: in with: STInST.STFileInParser to: out
-    ]
-    
-    SyntaxConverter class >> convertStream: in with: aParserClass to: out [
-        <category: 'instance creation'>
-        ^self new convertStream: in with: aParserClass to: out
-    ]
-
-    initialize [
-        <category: 'initialization'>
- super initialize.
- filter := [ :class | [true] ].
-        stuffToEmit := OrderedSet new.
-        classesToEmit := Dictionary new.
-        createdNamespaces := OrderedSet new.
-    ]
-
-    convertStream: in with: aParserClass to: out onError: aBlock [
-        <category: 'operation'>
-        self
-    outStream: out;
-    parseSmalltalkStream: in with: aParserClass onError: aBlock;
-    doEmitStuff.        
-    ]
-
-    convertStream: in with: aParserClass to: out [
-        <category: 'operation'>
-        self
-    outStream: out;
-    parseSmalltalkStream: in with: aParserClass;
-    doEmitStuff.        
-    ]
-
-    filter: aBlock [
-        <category: 'accessing'>
-        filter := aBlock.
-    ]
-    
-    outStream: out [
-        <category: 'accessing'>
-        outStream := out.
-    ]
-    
-    rewrite: node [
- ^rewriter isNil
-    ifTrue: [ node ]
-    ifFalse: [ rewriter executeTree: node; tree ].
-    ]
-
-    evaluate: node [
-        <category: 'overrides'>
-
- | rewritten |
- rewritten := self rewrite: node.
- node comments isEmpty ifFalse: [
-    stuffToEmit add: (EmittedComments comments: node comments source: node source) ].
-
-        ^super evaluate: rewritten
-    ]
-    
-    addRule: searchString parser: aParserClass [
- | tree rule |
- tree := aParserClass parseRewriteExpression: searchString.
- tree isMessage ifFalse: [ self error: 'expected ->' ].
- tree selector = #-> ifFalse: [ self error: 'expected ->' ].
- rule := RBStringReplaceRule
-    searchForTree: tree receiver
-    replaceWith: tree arguments first.
-
- rewriter isNil ifTrue: [ rewriter := ParseTreeRewriter new ].
- rewriter addRule: rule
-    ]
-
-    compile: node [
-        <category: 'collecting entities'>
-        
-        | rewritten method |
-
- rewritten := self rewrite: node.
-        method := self defineMethod: rewritten.                
-        (classesToEmit includesKey: currentClass asClass)
-            ifTrue: [ self addMethod: method toLoadedClass: currentClass ]
-            ifFalse: [ self addMethod: method toExtensionClass: currentClass ].
- ^method
-    ]
-    
-    lastEval [
-        <category: 'collecting entities'>
-
- | lastIsEval evalNamespace |
-
-        evalNamespace := currentNamespace = self defaultNamespace
-    ifTrue: [ nil ]
-    ifFalse: [ currentNamespace ].
-
-        lastIsEval := stuffToEmit notEmpty
-    and: [ (stuffToEmit last isKindOf: EmittedEval)
-    and: [ stuffToEmit last namespace = evalNamespace ]].
-
- ^lastIsEval
-    ifTrue: [ stuffToEmit last ]
-    ifFalse: [ stuffToEmit add: (EmittedEval new namespace: evalNamespace) ]
-    ]
-
-    createNamespaces [
- createdNamespaces do: [ :each || stmt |
-    stmt := RBMessageNode
-                receiver: (RBVariableNode named: (each superspace nameIn: self currentNamespace))
-                selector: #addSubspace:
-                arguments: { RBLiteralNode value: each name asSymbol }.
-    self lastEval addStatement: stmt
- ].
- createdNamespaces := OrderedSet new
-    ]
-
-    unknown: node [
-        <category: 'collecting entities'>
-        
- self createNamespaces.
- self lastEval addStatement: node.
-        ^false
-    ]
-    
-    doSubclass: receiver selector: selector arguments: argumentNodes [
-        <category: 'evaluating statements'>
-        
-        | class emittedClass |
-        
- createdNamespaces remove: self currentNamespace ifAbsent: [ ].
- self createNamespaces.
-
-        class := super defineSubclass: receiver
-                       selector: selector
-                       arguments: argumentNodes.        
-                            
-        Notification signal: ('Parsing %1' % {class}).
-        emittedClass := EmittedClass forClass: class.
-    
-        classesToEmit at: class put: emittedClass.
-        stuffToEmit add: emittedClass.
-        
-        ^false
-    ]
-    
-    doAddNamespace: receiver selector: selector arguments: argumentNodes [
- | ns |
- super doAddNamespace: receiver selector: selector arguments: argumentNodes.
-
-        ns := (self resolveNamespace: receiver) at: argumentNodes first value.
- createdNamespaces add: ns.
- ^false
-    ]
-
-    doEmitStuff [
-        <category: 'emitting'>
-
-        stuffToEmit
-    do: [ :each | each emitTo: outStream filteredBy: filter ]
-    separatedBy: [ outStream nl; nextPut: 12 asCharacter; nl ].
-    ]
-    
-    addMethod: aMethod toLoadedClass: aClass [
-        <category: 'collecting entities'>
-
-        (aClass isMetaclass)
-            ifTrue: [ (classesToEmit at: currentClass asClass) addClassMethod: aMethod ]
-            ifFalse: [ (classesToEmit at: currentClass) addMethod: aMethod ]
-    ]
-    
-    addMethod: aMethod toExtensionClass: aClass [
-        <category: 'collecting entities'>
-
-        ((stuffToEmit size > 0)
-            and: [ (stuffToEmit last isKindOf: EmittedClass) and: [ stuffToEmit last forClass = aClass ] ])                
-                ifTrue: [ stuffToEmit last addMethod: aMethod ]
-                ifFalse: [ stuffToEmit add: ((EmittedClass forExtension: currentClass) addMethod: aMethod) ]            
-    ]
-]
-
-
 String extend [
    asFilterOn: aBlock through: valueBlock [
  | regex |
@@ -413,7 +91,7 @@ Eval [
     verbose := false.
     outFile := nil.
     filter := [ :class | true ].
-    converter := SyntaxConverter new.
+    converter := STTools.Loader new.
     STInST.FileOutExporter defaultExporter: STInST.FormattingExporter.
     outFormats := Dictionary from: {
  'gst2' -> STInST.OldSyntaxExporter.
--
1.8.3.2


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

Pharo started to use only a carriage return in class comments,
re-add the SyntaxConverter and replace the cr with a nl. This
is not the best place to do (as it impacts all conversions) but
it is not clear where one could at it.

2013-08-10  Holger Hans Peter Freyther  <[hidden email]>

        * scripts/Convert.st: Replace \r with \n in class comments.
---
 ChangeLog          |  4 ++++
 scripts/Convert.st | 20 +++++++++++++++++++-
 2 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/ChangeLog b/ChangeLog
index 95ff619..e01eccc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 2013-08-10  Holger Hans Peter Freyther  <[hidden email]>
 
+ * scripts/Convert.st: Replace \r with \n in class comments.
+
+2013-08-10  Holger Hans Peter Freyther  <[hidden email]>
+
  * scripts/Convert.st: Use the STTools tools instead of the
  current code.
 
diff --git a/scripts/Convert.st b/scripts/Convert.st
index a7a402e..41f109f 100644
--- a/scripts/Convert.st
+++ b/scripts/Convert.st
@@ -81,17 +81,35 @@ String extend [
     ]
 ]
 
+
+STTools.Loader subclass: SyntaxConverter [
+    <category: 'Converter'>
+
+    doEmitStuff [
+        classesToEmit keysAndValuesDo: [:key :value |
+            | comment |
+            "Fixes for carriage return in Pharo"
+            comment := key comment.
+            comment ifNotNil: [
+                comment := comment replaceAll: Character cr with: Character nl.
+                key comment: comment.
+            ]].
+
+        super doEmitStuff.
+    ]
+]
 
 Eval [
     | helpString inFile outFile quiet verbose converter filter parser
  args inFormats outFormats rules |
+
     args := OrderedCollection new.
     parser := STInST.STFileInParser.
     quiet := false.
     verbose := false.
     outFile := nil.
     filter := [ :class | true ].
-    converter := STTools.Loader new.
+    converter := SyntaxConverter new.
     STInST.FileOutExporter defaultExporter: STInST.FormattingExporter.
     outFormats := Dictionary from: {
  'gst2' -> STInST.OldSyntaxExporter.
--
1.8.3.2


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

For the NewSyntaxConverter and VisualGST we will need to provide this
method for the tools to work.

2013-08-18  Holger Hans Peter Freyther  <[hidden email]>

        * STLoaderObjs.st: Add LoadedMethod>>#methodRecompilationSourceString.
---
 packages/stinst/parser/ChangeLog       | 4 ++++
 packages/stinst/parser/STLoaderObjs.st | 6 ++++++
 2 files changed, 10 insertions(+)

diff --git a/packages/stinst/parser/ChangeLog b/packages/stinst/parser/ChangeLog
index 9c73d6f..d1a5106 100644
--- a/packages/stinst/parser/ChangeLog
+++ b/packages/stinst/parser/ChangeLog
@@ -1,3 +1,7 @@
+2013-08-18  Holger Hans Peter Freyther  <[hidden email]>
+
+ * STLoaderObjs.st: Add LoadedMethod>>#methodRecompilationSourceString.
+
 2013-08-10  Gwenael Casaccio <[hidden email]>
 
  * RBParser.st: Fix RBScanner>>#scanNumberValue.
diff --git a/packages/stinst/parser/STLoaderObjs.st b/packages/stinst/parser/STLoaderObjs.st
index 9bbb0ea..1f54155 100644
--- a/packages/stinst/parser/STLoaderObjs.st
+++ b/packages/stinst/parser/STLoaderObjs.st
@@ -1280,6 +1280,12 @@ methodSourceCode
     ^node source asSourceCode
 !
 
+methodRecompilationSourceString
+    ^self isOldSyntax
+        ifTrue: [ self methodFormattedSourceString ]
+        ifFalse: [ self methodSourceString trimSeparators ].
+!
+
 selector
     ^node selector asSymbol
 !
--
1.8.3.2


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

2013-08-19  Holger Hans Peter Freyther  <[hidden email]>

        * RewriteTests.st: Add TestRewrite>>#testOldSyntaxSymbolParsing.
        * SqueakParser.st: Add SqueakFileInScanner>>#scanBinary:.
---
 packages/stinst/parser/ChangeLog       |  5 +++++
 packages/stinst/parser/RewriteTests.st | 22 ++++++++++++++++++++++
 packages/stinst/parser/SqueakParser.st |  8 ++++++++
 3 files changed, 35 insertions(+)

diff --git a/packages/stinst/parser/ChangeLog b/packages/stinst/parser/ChangeLog
index d1a5106..b3a0a9f 100644
--- a/packages/stinst/parser/ChangeLog
+++ b/packages/stinst/parser/ChangeLog
@@ -1,3 +1,8 @@
+2013-08-19  Holger Hans Peter Freyther  <[hidden email]>
+
+ * RewriteTests.st: Add TestRewrite>>#testOldSyntaxSymbolParsing.
+ * SqueakParser.st: Add SqueakFileInScanner>>#scanBinary:.
+
 2013-08-18  Holger Hans Peter Freyther  <[hidden email]>
 
  * STLoaderObjs.st: Add LoadedMethod>>#methodRecompilationSourceString.
diff --git a/packages/stinst/parser/RewriteTests.st b/packages/stinst/parser/RewriteTests.st
index 489a4f8..3712f92 100644
--- a/packages/stinst/parser/RewriteTests.st
+++ b/packages/stinst/parser/RewriteTests.st
@@ -428,6 +428,28 @@ TestCase subclass: TestRewrite [
         self assert: (out contents indexOfSubCollection: 'Osmo.LogManager') = 0.
     ]
 
+
+    testOldSyntaxSymbolParsing [
+        | res |
+        res := (STClassLoader new
+            parseSmalltalkStream:
+'Object subclass: #PhexMatcher
+ instanceVariableNames: ''value state''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''Phexample-Core''!
+
+!PhexMatcher methodsFor: ''expecting'' stamp: ''JoeExample 10/27/2009 18:35''!
+< expected
+ ^self expect: expected using: #<! !' readStream with: SqueakFileInParser) first.
+
+ "Compare..."
+ self assert: (res >> #<) methodSourceString = '< expected
+ ^self expect: expected using: #<'.
+
+ (res >> #<) methodFormattedSourceString printNl.
+    ]
+
     testOldSyntaxNamespaceRewrite [
         | class tree rule rewriter res out|
 
diff --git a/packages/stinst/parser/SqueakParser.st b/packages/stinst/parser/SqueakParser.st
index 6be255d..3747518 100644
--- a/packages/stinst/parser/SqueakParser.st
+++ b/packages/stinst/parser/SqueakParser.st
@@ -152,6 +152,14 @@ STFileScanner subclass: SqueakFileInScanner [
  self step].
 
         val := buffer contents.
+
+        "Skip a trailing ! as it might come from a #<! !"
+        val last = $!
+            ifTrue: [
+                stream skip: -1.
+                currentCharacter := $!.
+                characterType := #binary.
+                val := val allButLast].
         val := val asSymbol.
         ^aClass value: val start: tokenStart
     ]
--
1.8.3.2


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

2013-08-19  Holger Hans Peter Freyther  <[hidden email]>

        * Extensions.st: Add >>#methodViewIcon extension to
        STInST.STClassLoaderObjects.LoadedMethod.
---
 packages/visualgst/ChangeLog     | 5 +++++
 packages/visualgst/Extensions.st | 8 ++++++++
 2 files changed, 13 insertions(+)

diff --git a/packages/visualgst/ChangeLog b/packages/visualgst/ChangeLog
index 0a24b05..1beb5fa 100644
--- a/packages/visualgst/ChangeLog
+++ b/packages/visualgst/ChangeLog
@@ -1,3 +1,8 @@
+2013-08-19  Holger Hans Peter Freyther  <[hidden email]>
+
+ * Extensions.st: Add >>#methodViewIcon extension to
+ STInST.STClassLoaderObjects.LoadedMethod.
+
 2013-06-18  Gwenael Casaccio  <[hidden email]>
 
  * Debugger/Extensions.st: Added.
diff --git a/packages/visualgst/Extensions.st b/packages/visualgst/Extensions.st
index 6821346..d4c05e6 100644
--- a/packages/visualgst/Extensions.st
+++ b/packages/visualgst/Extensions.st
@@ -807,3 +807,11 @@ Smalltalk.PackageLoader class extend [
  ^ root
     ]
 ]
+
+STInST.STClassLoaderObjects.LoadedMethod extend [
+    methodViewIcon [
+        <category: '*VisualGST'>
+        ^ nil
+    ]
+]
+
--
1.8.3.2


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

The VisualGST SUnit utility is using DebugTestCommand but there was
no user of RunTestCommand. Rename the class and document that it is
still not working properly.

2013-08-19  Holger Hans Peter Freyther  <[hidden email]>

        * Commands/MethodMenus/DebugTestCommand.st: Rename class from RunTestCommand
        to DebugTestCommand.
---
 packages/visualgst/ChangeLog                                | 5 +++++
 packages/visualgst/Commands/MethodMenus/DebugTestCommand.st | 8 ++++++--
 2 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/packages/visualgst/ChangeLog b/packages/visualgst/ChangeLog
index 1beb5fa..efae889 100644
--- a/packages/visualgst/ChangeLog
+++ b/packages/visualgst/ChangeLog
@@ -1,5 +1,10 @@
 2013-08-19  Holger Hans Peter Freyther  <[hidden email]>
 
+ * Commands/MethodMenus/DebugTestCommand.st: Rename class from RunTestCommand
+ to DebugTestCommand.
+
+2013-08-19  Holger Hans Peter Freyther  <[hidden email]>
+
  * Extensions.st: Add >>#methodViewIcon extension to
  STInST.STClassLoaderObjects.LoadedMethod.
 
diff --git a/packages/visualgst/Commands/MethodMenus/DebugTestCommand.st b/packages/visualgst/Commands/MethodMenus/DebugTestCommand.st
index f9db1db..5463431 100644
--- a/packages/visualgst/Commands/MethodMenus/DebugTestCommand.st
+++ b/packages/visualgst/Commands/MethodMenus/DebugTestCommand.st
@@ -1,6 +1,6 @@
 "======================================================================
 |
-| RunTestCommand class definition
+| DebugTestCommand class definition
 |
 ======================================================================"
 
@@ -33,12 +33,16 @@
 |
 ======================================================================"
 
-MethodCommand subclass: RunTestCommand [
+MethodCommand subclass: DebugTestCommand [
+
+    <comment: 'Still broken for SUNit... >>#valid is run on a target
+    that is not actually a method....'>
 
     execute [
  <category: 'command'>
 
         target state classOrMeta debug: target state selector
     ]
+
 ]
 
--
1.8.3.2


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