Initial port from Pharo
Based on 305ae856d4b551 from https://github.com/svenvc/ston.git
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,18 @@
+
+syntax: glob
+*Init.c
+makefile
+*.so
+*.debug
+*.H
+*.o
+*.STH
+*.sc
+objbc
+objvc
+objmingw
+*.class
+java/libs/*.jar
+java/libs-src/*.jar
+*-Test.xml
+st.chg
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Make.proto Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,149 @@
+# $Header$
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: stx_goodies_ston.
+#
+# Warning: once you modify this file, do not rerun
+# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
+#
+# The Makefile as generated by this Make.proto supports the following targets:
+# make - compile all st-files to a classLib
+# make clean - clean all temp files
+# make clobber - clean all
+#
+# This file contains definitions for Unix based platforms.
+# It shares common definitions with the win32-make in Make.spec.
+
+#
+# position (of this package) in directory hierarchy:
+# (must point to ST/X top directory, for tools and includes)
+TOP=../..
+INCLUDE_TOP=$(TOP)/..
+
+# subdirectories where targets are to be made:
+SUBDIRS=
+
+
+# subdirectories where Makefiles are to be made:
+# (only define if different from SUBDIRS)
+# ALLSUBDIRS=
+
+REQUIRED_SUPPORT_DIRS=
+
+# if your embedded C code requires any system includes,
+# add the path(es) here:,
+# ********** OPTIONAL: MODIFY the next lines ***
+# LOCALINCLUDES=-Ifoo -Ibar
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2 -I$(INCLUDE_TOP)/stx/libcompat -I$(INCLUDE_TOP)/stx/libhtml -I$(INCLUDE_TOP)/stx/libview
+
+
+# if you need any additional defines for embedded C code,
+# add them here:,
+# ********** OPTIONAL: MODIFY the next lines ***
+# LOCALDEFINES=-Dfoo -Dbar -DDEBUG
+LOCALDEFINES=
+
+LIBNAME=libstx_goodies_ston
+STCLOCALOPT='-package=$(PACKAGE)' -I. $(LOCALINCLUDES) $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -headerDir=. -varPrefix=$(LIBNAME)
+
+
+# ********** OPTIONAL: MODIFY the next line ***
+# additional C-libraries that should be pre-linked with the class-objects
+LD_OBJ_LIBS=
+LOCAL_SHARED_LIBS=
+
+
+# ********** OPTIONAL: MODIFY the next line ***
+# additional C targets or libraries should be added below
+LOCAL_EXTRA_TARGETS=
+
+OBJS= $(COMMON_OBJS) $(UNIX_OBJS)
+
+
+
+all:: preMake classLibRule postMake
+
+pre_objs::
+
+
+
+
+
+
+# Enforce recompilation of package definition class if Mercurial working
+# copy state changes. Together with --guessVersion it ensures that package
+# definition class always contains correct binary revision string.
+ifneq (**NOHG**, $(shell hg root 2> /dev/null || echo -n '**NOHG**'))
+stx_goodies_ston.$(O): $(shell hg root)/.hg/dirstate
+endif
+
+
+
+
+# run default testsuite for this package
+test: $(TOP)/goodies/builder/reports
+ $(MAKE) -C $(TOP)/goodies/builder/reports -f Makefile.init
+ $(TOP)/goodies/builder/reports/report-runner.sh -D . -r Builder::TestReport -p $(PACKAGE)
+
+
+
+# add more install actions here
+install::
+
+# add more install actions for aux-files (resources) here
+installAux::
+
+# add more preMake actions here
+preMake::
+
+# add more postMake actions here
+postMake:: cleanjunk
+
+# build all mandatory prerequisite packages (containing superclasses) for this package
+prereq:
+ cd ../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ cd ../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ cd ../../libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ cd ../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ cd ../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ cd ../../libwidg && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ cd ../../libhtml && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ cd ../../libwidg2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ cd ../../libcompat && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+
+
+
+# build all packages containing referenced classes for this package
+# they are not needed to compile the package (but later, to load it)
+references:
+
+
+cleanjunk::
+ -rm -f *.s *.s2
+
+clean::
+ -rm -f *.o *.H
+
+clobber:: clean
+ -rm -f *.so *.dll
+
+
+# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)STON.$(O) STON.$(C) STON.$(H): STON.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONCStyleCommentsSkipStream.$(O) STONCStyleCommentsSkipStream.$(C) STONCStyleCommentsSkipStream.$(H): STONCStyleCommentsSkipStream.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONFileReference.$(O) STONFileReference.$(C) STONFileReference.$(H): STONFileReference.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libcompat/FileReference.$(H) $(STCHDR)
+$(OUTDIR)STONJSON.$(O) STONJSON.$(C) STONJSON.$(H): STONJSON.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONReader.$(O) STONReader.$(C) STONReader.$(H): STONReader.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONReaderError.$(O) STONReaderError.$(C) STONReaderError.$(H): STONReaderError.st $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONReference.$(O) STONReference.$(C) STONReference.$(H): STONReference.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONStreamWriter.$(O) STONStreamWriter.$(C) STONStreamWriter.$(H): STONStreamWriter.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONWriter.$(O) STONWriter.$(C) STONWriter.$(H): STONWriter.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONWriterError.$(O) STONWriterError.$(C) STONWriterError.$(H): STONWriterError.st $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)stx_goodies_ston.$(O) stx_goodies_ston.$(C) stx_goodies_ston.$(H): stx_goodies_ston.st $(INCLUDE_TOP)/stx/libbasic/LibraryDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProjectDefinition.$(H) $(STCHDR)
+$(OUTDIR)STONListWriter.$(O) STONListWriter.$(C) STONListWriter.$(H): STONListWriter.st $(INCLUDE_TOP)/stx/goodies/ston/STONStreamWriter.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONMapWriter.$(O) STONMapWriter.$(C) STONMapWriter.$(H): STONMapWriter.st $(INCLUDE_TOP)/stx/goodies/ston/STONStreamWriter.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONShortListWriter.$(O) STONShortListWriter.$(C) STONShortListWriter.$(H): STONShortListWriter.st $(INCLUDE_TOP)/stx/goodies/ston/STONListWriter.$(H) $(INCLUDE_TOP)/stx/goodies/ston/STONStreamWriter.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)/stx/libbasic/AbstractTime.$(H) $(INCLUDE_TOP)/stx/libbasic/ArithmeticValue.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Association.$(H) $(INCLUDE_TOP)/stx/libbasic/Bag.$(H) $(INCLUDE_TOP)/stx/libbasic/Behavior.$(H) $(INCLUDE_TOP)/stx/libbasic/Boolean.$(H) $(INCLUDE_TOP)/stx/libbasic/ByteArray.$(H) $(INCLUDE_TOP)/stx/libbasic/Character.$(H) $(INCLUDE_TOP)/stx/libbasic/CharacterArray.$(H) $(INCLUDE_TOP)/stx/libbasic/Class.$(H) $(INCLUDE_TOP)/stx/libbasic/ClassDescription.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Date.$(H) $(INCLUDE_TOP)/stx/libbasic/Dictionary.$(H) $(INCLUDE_TOP)/stx/libbasic/Filename.$(H) $(INCLUDE_TOP)/stx/libbasic/Fraction.$(H) $(INCLUDE_TOP)/stx/libbasic/Integer.$(H) $(INCLUDE_TOP)/stx/libbasic/Interval.$(H) $(INCLUDE_TOP)/stx/libbasic/LookupKey.$(H) $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(INCLUDE_TOP)/stx/libbasic/Metaclass.$(H) $(INCLUDE_TOP)/stx/libbasic/Number.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/OrderedDictionary.$(H) $(INCLUDE_TOP)/stx/libbasic/Point.$(H) $(INCLUDE_TOP)/stx/libbasic/ReadOnlySequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Set.$(H) $(INCLUDE_TOP)/stx/libbasic/String.$(H) $(INCLUDE_TOP)/stx/libbasic/Symbol.$(H) $(INCLUDE_TOP)/stx/libbasic/Time.$(H) $(INCLUDE_TOP)/stx/libbasic/Timestamp.$(H) $(INCLUDE_TOP)/stx/libbasic/UndefinedObject.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(INCLUDE_TOP)/stx/libbasic2/RunArray.$(H) $(INCLUDE_TOP)/stx/libhtml/URL.$(H) $(INCLUDE_TOP)/stx/libview/Color.$(H) $(STCHDR)
+
+# ENDMAKEDEPEND --- do not remove this line
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Make.spec Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,90 @@
+# $Header$
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: stx_goodies_ston.
+#
+# Warning: once you modify this file, do not rerun
+# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
+#
+# This file contains specifications which are common to all platforms.
+#
+
+# Do NOT CHANGE THESE DEFINITIONS
+# (otherwise, ST/X will have a hard time to find out the packages location from its packageID,
+# to find the source code of a class and to find the library for a package)
+MODULE=stx
+MODULE_DIR=goodies/ston
+PACKAGE=$(MODULE):$(MODULE_DIR)
+
+
+# Argument(s) to the stc compiler (stc --usage).
+# -headerDir=. : create header files locally
+# (if removed, they will be created as common
+# -Pxxx : defines the package
+# -Zxxx : a prefix for variables within the classLib
+# -Dxxx : defines passed to CC for inline C-code
+# -Ixxx : include path passed to CC for inline C-code
+# +optspace : optimized for space
+# +optspace2 : optimized more for space
+# +optspace3 : optimized even more for space
+# +optinline : generate inline code for some ST constructs
+# +inlineNew : additionally inline new
+# +inlineMath : additionally inline some floatPnt math stuff
+#
+# ********** OPTIONAL: MODIFY the next line(s) ***
+# STCLOCALOPTIMIZATIONS=+optinline +inlineNew
+# STCLOCALOPTIMIZATIONS=+optspace3
+STCLOCALOPTIMIZATIONS=+optspace3
+
+
+# Argument(s) to the stc compiler (stc --usage).
+# -warn : no warnings
+# -warnNonStandard : no warnings about ST/X extensions
+# -warnEOLComments : no warnings about EOL comment extension
+# -warnPrivacy : no warnings about privateClass extension
+# -warnUnused : no warnings about unused variables
+#
+# ********** OPTIONAL: MODIFY the next line(s) ***
+# STCWARNINGS=-warn
+# STCWARNINGS=-warnNonStandard
+# STCWARNINGS=-warnEOLComments
+STCWARNINGS=-warnNonStandard
+
+COMMON_CLASSES= \
+ STON \
+ STONCStyleCommentsSkipStream \
+ STONFileReference \
+ STONJSON \
+ STONReader \
+ STONReaderError \
+ STONReference \
+ STONStreamWriter \
+ STONWriter \
+ STONWriterError \
+ stx_goodies_ston \
+ STONListWriter \
+ STONMapWriter \
+ STONShortListWriter \
+
+
+
+
+COMMON_OBJS= \
+ $(OUTDIR)STON.$(O) \
+ $(OUTDIR)STONCStyleCommentsSkipStream.$(O) \
+ $(OUTDIR)STONFileReference.$(O) \
+ $(OUTDIR)STONJSON.$(O) \
+ $(OUTDIR)STONReader.$(O) \
+ $(OUTDIR)STONReaderError.$(O) \
+ $(OUTDIR)STONReference.$(O) \
+ $(OUTDIR)STONStreamWriter.$(O) \
+ $(OUTDIR)STONWriter.$(O) \
+ $(OUTDIR)STONWriterError.$(O) \
+ $(OUTDIR)stx_goodies_ston.$(O) \
+ $(OUTDIR)STONListWriter.$(O) \
+ $(OUTDIR)STONMapWriter.$(O) \
+ $(OUTDIR)STONShortListWriter.$(O) \
+ $(OUTDIR)extensions.$(O) \
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Makefile.init Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,27 @@
+#
+# DO NOT EDIT
+#
+# make uses this file (Makefile) only, if there is no
+# file named "makefile" (lower-case m) in the same directory.
+# My only task is to generate the real makefile and call make again.
+# Thereafter, I am no longer used and needed.
+#
+# MACOSX caveat:
+# as filenames are not case sensitive (in a default setup),
+# we cannot use the above trick. Therefore, this file is now named
+# "Makefile.init", and you have to execute "make -f Makefile.init" to
+# get the initial makefile. This is now also done by the toplevel CONFIG
+# script.
+
+.PHONY: run
+
+run: makefile
+ $(MAKE) -f makefile
+
+#only needed for the definition of $(TOP)
+include Make.proto
+
+makefile: mf
+
+mf:
+ $(TOP)/rules/stmkmf
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/STON.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,102 @@
+"{ Package: 'stx:goodies/ston' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#STON
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Core-Facade'
+!
+
+!STON class methodsFor:'accessing'!
+
+associationClass
+ ^ Association
+!
+
+classNameKey
+ ^ #className
+!
+
+jsonWriter
+ ^ STONWriter new
+ jsonMode: true;
+ referencePolicy: #error;
+ yourself
+!
+
+listClass
+ ^ Array
+!
+
+mapClass
+ ^ Dictionary
+!
+
+reader
+ ^ STONReader new
+!
+
+writer
+ ^ STONWriter new
+! !
+
+!STON class methodsFor:'convencience'!
+
+fromStream: readStream
+ ^ (self reader on: readStream) next
+!
+
+fromStreamWithComments: readStream
+ ^ (self reader on: (STONCStyleCommentsSkipStream on: readStream)) next
+!
+
+fromString: string
+ ^ self fromStream: string readStream
+!
+
+fromStringWithComments: string
+ ^ self fromStreamWithComments: string readStream
+!
+
+put: object asJsonOnStream: stream
+ (self jsonWriter on: stream) nextPut: object
+!
+
+put: object asJsonOnStreamPretty: stream
+ (self jsonWriter on: stream)
+ prettyPrint: true;
+ nextPut: object
+!
+
+put: object onStream: stream
+ (self writer on: stream) nextPut: object
+!
+
+put: object onStreamPretty: stream
+ (self writer on: stream)
+ prettyPrint: true;
+ nextPut: object
+!
+
+toJsonString: object
+ ^ String streamContents: [ :stream |
+ self put: object asJsonOnStream: stream ]
+!
+
+toJsonStringPretty: object
+ ^ String streamContents: [ :stream |
+ self put: object asJsonOnStreamPretty: stream ]
+!
+
+toString: object
+ ^ String streamContents: [ :stream |
+ self put: object onStream: stream ]
+!
+
+toStringPretty: object
+ ^ String streamContents: [ :stream |
+ self put: object onStreamPretty: stream ]
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/STONCStyleCommentsSkipStream.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,233 @@
+"{ Package: 'stx:goodies/ston' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#STONCStyleCommentsSkipStream
+ instanceVariableNames:'stream peekedCharacter delimiter escape'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Core-Reader'
+!
+
+!STONCStyleCommentsSkipStream class methodsFor:'instance creation'!
+
+on: readStream
+ ^ self new
+ on: readStream;
+ yourself
+! !
+
+!STONCStyleCommentsSkipStream methodsFor:'accessing'!
+
+collectionSpecies
+ ^ String
+!
+
+next
+ ^ peekedCharacter
+ ifNil: [
+ stream atEnd
+ ifFalse: [ self nextNonCommentChar ] ]
+ ifNotNil: [ | character |
+ character := peekedCharacter.
+ peekedCharacter := nil.
+ character ]
+!
+
+next: requestedCount
+ "Read requestedCount elements into new collection and return it,
+ it could be that less elements were available"
+
+ ^ self
+ next: requestedCount
+ into: (self collectionSpecies new: requestedCount)
+!
+
+next: requestedCount into: collection
+ "Read requestedCount elements into collection,
+ returning a copy if less elements are available"
+
+ ^ self
+ next: requestedCount
+ into: collection
+ startingAt: 1
+!
+
+next: requestedCount into: collection startingAt: offset
+ "Read requestedCount elements into collection starting at offset,
+ returning a copy if less elements are available"
+
+ | readCount |
+ readCount := self
+ readInto: collection
+ startingAt: offset
+ count: requestedCount.
+ ^ requestedCount = readCount
+ ifTrue: [ collection ]
+ ifFalse: [ collection copyFrom: 1 to: offset + readCount - 1 ]
+!
+
+nextLine
+ "Read a CR, LF or CRLF terminated line, returning the contents of the line without the EOL. Return nil when the receiver is #atEnd."
+
+ self atEnd ifTrue: [ ^ nil ].
+ ^ self collectionSpecies streamContents: [ :out | | eol char |
+ eol := false.
+ [ eol ] whileFalse: [
+ char := self next.
+ (char isNil or: [ char = Character lf ])
+ ifTrue: [ eol := true ]
+ ifFalse: [
+ char = Character cr
+ ifTrue: [ eol := true. self peekFor: Character lf ]
+ ifFalse: [ out nextPut: char ] ] ] ]
+!
+
+peek
+ ^ peekedCharacter
+ ifNil: [
+ stream atEnd
+ ifFalse: [
+ peekedCharacter := self nextNonCommentChar ] ]
+!
+
+peekFor: object
+ ^ self peek = object
+ ifTrue: [
+ self next.
+ true ]
+ ifFalse: [ false ]
+!
+
+position
+ ^ stream position
+!
+
+readInto: collection startingAt: offset count: requestedCount
+ "Read count elements and place them in collection starting at offset.
+ Return the number of elements actually read."
+
+ ^ peekedCharacter
+ ifNil: [
+ 0 to: requestedCount - 1 do: [ :count | | object |
+ (object := self nextNonCommentChar) ifNil: [ ^ count ].
+ collection at: offset + count put: object ].
+ ^ requestedCount ]
+ ifNotNil: [
+ collection at: offset put: peekedCharacter.
+ peekedCharacter := nil.
+ (self
+ readInto: collection
+ startingAt: offset + 1
+ count: requestedCount - 1) + 1 ]
+!
+
+skip: count
+ count timesRepeat: [ self next ]
+!
+
+upTo: anObject
+ ^ self collectionSpecies
+ streamContents: [ :out | | element |
+ [ self atEnd or: [ (element := self next) = anObject ] ] whileFalse: [
+ out nextPut: element ] ]
+!
+
+upToEnd
+ ^ self collectionSpecies
+ streamContents: [ :collectionStream |
+ [ self atEnd ] whileFalse: [ collectionStream nextPut: self next ] ]
+!
+
+wrappedStream
+ ^ stream
+! !
+
+!STONCStyleCommentsSkipStream methodsFor:'initialize-release'!
+
+close
+ stream close
+!
+
+on: readStream
+ stream := readStream
+! !
+
+!STONCStyleCommentsSkipStream methodsFor:'private'!
+
+consumeComment
+ stream peek = $/ ifTrue: [ self consumeToEOL ].
+ stream peek = $* ifTrue: [ self consumeToCommentEnd ]
+!
+
+consumeToCommentEnd
+ [ stream atEnd or: [ stream next = $* and: [ stream peekFor: $/ ] ] ] whileFalse
+!
+
+consumeToEOL
+ | eol char |
+ eol := false.
+ [ eol ] whileFalse: [
+ char := stream next.
+ (char isNil or: [ char = Character lf ])
+ ifTrue: [ eol := true ]
+ ifFalse: [
+ char = Character cr
+ ifTrue: [
+ eol := true.
+ stream peekFor: Character lf ] ] ]
+!
+
+escape
+ "Return true when we previously read a backslash escape inside a string,
+ so that the next string delimiter should be returned as is"
+
+ ^ escape = true
+!
+
+handleStringDelimiter: char
+ self escape
+ ifTrue: [ escape := false ]
+ ifFalse: [
+ self insideString
+ ifTrue: [
+ char = delimiter
+ ifTrue: [ delimiter := nil ] ]
+ ifFalse: [ delimiter := char ] ].
+ ^ char
+!
+
+insideString
+ "Return true when we are currently inside a string where comments should be ignored."
+
+ ^ (delimiter = $') | (delimiter = $")
+!
+
+nextNonCommentChar
+ | char |
+ char := stream next.
+ (self insideString and: [ char = $\ ])
+ ifTrue: [
+ escape := true.
+ ^ char ].
+ (char = $') | (char = $")
+ ifTrue: [
+ ^ self handleStringDelimiter: char ].
+ escape := false.
+ ^ (char = $/ and: [ self insideString not and: [ (stream peek = $/) | (stream peek = $*) ] ])
+ ifTrue: [
+ self consumeComment.
+ stream next ]
+ ifFalse: [ char ]
+! !
+
+!STONCStyleCommentsSkipStream methodsFor:'testing'!
+
+atEnd
+ ^ self peek isNil
+!
+
+isBinary
+ ^ false
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/STONFileReference.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,23 @@
+"{ Package: 'stx:goodies/ston' }"
+
+"{ NameSpace: Smalltalk }"
+
+FileReference subclass:#STONFileReference
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Core-Reader'
+!
+
+!STONFileReference class methodsFor:'ston'!
+
+fromSton: stonReader
+ ^ stonReader parseListSingleton asFilename.
+
+ "Modified: / 20-05-2020 / 12:41:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+stonName
+ ^ #FILE
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/STONJSON.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,37 @@
+"{ Package: 'stx:goodies/ston' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#STONJSON
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Core-Facade'
+!
+
+!STONJSON class methodsFor:'convenience'!
+
+fromStream: stream
+ ^ STON fromStream: stream
+!
+
+fromString: string
+ ^ STON fromString: string
+!
+
+put: object onStream: stream
+ STON put: object asJsonOnStream: stream
+!
+
+put: object onStreamPretty: stream
+ STON put: object asJsonOnStreamPretty: stream
+!
+
+toString: object
+ ^ STON toJsonString: object
+!
+
+toStringPretty: object
+ ^ STON toJsonStringPretty: object
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/STONListWriter.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,18 @@
+"{ Package: 'stx:goodies/ston' }"
+
+"{ NameSpace: Smalltalk }"
+
+STONStreamWriter subclass:#STONListWriter
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Core-Writer'
+!
+
+!STONListWriter methodsFor:'accessing'!
+
+add: anObject
+ first ifTrue: [ first := false ] ifFalse: [ writer listElementSeparator ].
+ writer nextPut: anObject
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/STONMapWriter.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,18 @@
+"{ Package: 'stx:goodies/ston' }"
+
+"{ NameSpace: Smalltalk }"
+
+STONStreamWriter subclass:#STONMapWriter
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Core-Writer'
+!
+
+!STONMapWriter methodsFor:'accessing'!
+
+at: key put: value
+ first ifTrue: [ first := false ] ifFalse: [ writer mapElementSeparator ].
+ writer encodeKey: key value: value
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/STONReader.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,562 @@
+"{ Package: 'stx:goodies/ston' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#STONReader
+ instanceVariableNames:'readStream objects classes unresolvedReferences stringStream
+ acceptUnknownClasses newLine convertNewLines'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Core-Reader'
+!
+
+
+!STONReader class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+!
+
+on: readStream
+ ^ self new
+ on: readStream;
+ yourself
+! !
+
+!STONReader methodsFor:'error handling'!
+
+error: aString
+ | streamPosition |
+ "Remain compatible with streams that don't understand #position"
+ streamPosition := [ readStream position ]
+ on: MessageNotUnderstood do: [ nil ].
+ ^ STONReaderError signal: aString streamPosition: streamPosition
+! !
+
+!STONReader methodsFor:'initialize-release'!
+
+acceptUnknownClasses: boolean
+ acceptUnknownClasses := boolean
+!
+
+allowComplexMapKeys: boolean
+ "This is a no-op, this used to be an option, but it is now always enabled"
+!
+
+close
+ readStream ifNotNil: [
+ readStream close.
+ readStream := nil ]
+!
+
+convertNewLines: boolean
+ "When true, any newline CR, LF or CRLF read unescaped inside strings or symbols
+ will be converted to the newline convention chosen, see #newLine:
+ The default is false, not doing any convertions."
+
+ convertNewLines := boolean
+!
+
+initialize
+ super initialize.
+ objects := IdentityDictionary new.
+ classes := IdentityDictionary new.
+ acceptUnknownClasses := convertNewLines := false.
+ newLine := Character cr asString.
+ unresolvedReferences := 0
+
+ "Modified: / 04-06-2019 / 10:58:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+newLine: string
+ "Set the newline convention to be used when converting newlines, see #convertNewLines"
+
+ newLine := string
+!
+
+on: aReadStream
+ readStream := aReadStream
+!
+
+optimizeForLargeStructures
+ self class environment
+ at: #FLLargeIdentityDictionary
+ ifPresent: [ :identityDictionaryClass | objects := identityDictionaryClass new ]
+!
+
+reset
+ unresolvedReferences := 0.
+ objects removeAll
+! !
+
+!STONReader methodsFor:'parsing'!
+
+parseList
+ | reference array |
+ reference := self newReference.
+ array := STON listClass streamContents: [ :stream |
+ self parseListDo: [ :each | stream nextPut: each ] ].
+ self setReference: reference to: array.
+ ^ array
+!
+
+parseListDo: block
+ | index |
+ self expectChar: $[.
+ (self matchChar: $]) ifTrue: [ ^ self ]. "short cut for empty lists"
+ index := 1.
+ [ readStream atEnd ] whileFalse: [
+ block cull: self parseValue cull: index.
+ (self matchChar: $]) ifTrue: [ ^ self ].
+ index := index + 1.
+ self expectChar: $, ].
+ self error: 'end of list expected'
+!
+
+parseListSingleton
+ | value |
+ value := nil.
+ self parseListDo: [ :each :index |
+ index = 1 ifTrue: [ value := each ] ].
+ ^ value
+!
+
+parseMap
+ | map |
+ map := STON mapClass new.
+ self storeReference: map.
+ self parseMapDo: [ :key :value |
+ map at: key put: value ].
+ ^ map
+!
+
+parseMapDo: block
+ self expectChar: ${.
+ (self matchChar: $}) ifTrue: [ ^ self ]. "short cut for empty maps"
+ [ readStream atEnd ] whileFalse: [ | name value |
+ name := self parseSimpleValue.
+ self expectChar: $:.
+ value := self parseValue.
+ block value: name value: value.
+ "The above is a more efficient way to say 'self parseValue' and using the returned association"
+ (self matchChar: $}) ifTrue: [ ^ self ].
+ self expectChar: $, ].
+ self error: 'end of map expected'
+!
+
+parseNamedInstVarsFor: anObject
+ self parseMapDo: [ :instVarName :value |
+ anObject instVarNamed: instVarName asString put: value ]
+!
+
+parseObject
+ | targetClass reference object |
+ [
+ reference := self newReference.
+ targetClass := self parseClass.
+ object := targetClass fromSton: self .
+ self setReference: reference to: object ]
+ on: NotFoundError
+ do: [ :notFound |
+ acceptUnknownClasses
+ ifTrue: [
+ object := STON mapClass new.
+ self storeReference: object.
+ self parseMapDo: [ :key :value |
+ object at: key put: value ].
+ object at: STON classNameKey put: notFound parameter ]
+ ifFalse: [ self error: 'Cannot resolve class named ', notFound parameter printString ] ].
+ ^ object
+
+ "Modified: / 20-05-2020 / 12:48:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parseSimpleValue
+ | char |
+ readStream atEnd ifFalse: [
+ (self isClassStartChar: (char := readStream peek))
+ ifTrue: [ ^ self parseObject ].
+ char = ${
+ ifTrue: [ ^ self parseMap ].
+ char = $[
+ ifTrue: [ ^ self parseList ].
+ (char = $' or: [ char = $" ])
+ ifTrue: [ ^ self parseString ].
+ char = $#
+ ifTrue: [ ^ self parseSymbol ].
+ char = $@
+ ifTrue: [ ^ self parseReference ].
+ (char = $- or: [ char isDigit ])
+ ifTrue: [ ^ self parseNumber ].
+ self parseConstantDo: [ :value | ^ value ] ].
+ self error: 'invalid input'
+!
+
+parseValue
+ | value |
+ value := self parseSimpleValue.
+ ^ (self matchChar: $:)
+ ifTrue: [ STON associationClass key: value value: self parseValue ]
+ ifFalse: [ value ]
+! !
+
+!STONReader methodsFor:'parsing-internal'!
+
+parseCharacter
+ | char |
+ ^ (char := readStream next) = $\
+ ifTrue: [ self parseEscapedCharacter ]
+ ifFalse: [ char ]
+!
+
+parseCharacterConvertingNewLinesOn: writeStream
+ | char |
+ (char := readStream next) = $\
+ ifTrue: [ writeStream nextPut: self parseEscapedCharacter ]
+ ifFalse: [
+ char = Character lf
+ ifTrue: [ writeStream nextPutAll: newLine ]
+ ifFalse: [
+ char = Character cr
+ ifTrue: [
+ readStream peekFor: Character lf.
+ writeStream nextPutAll: newLine ]
+ ifFalse: [ writeStream nextPut: char ] ] ]
+!
+
+parseCharacterHexDigit
+ | digit |
+ readStream atEnd ifFalse: [
+ digit := readStream next asInteger.
+ (digit between: "$0" 48 and: "$9" 57)
+ ifTrue: [ ^ digit - 48 ].
+ (digit between: "$A" 65 and: "$F" 70)
+ ifTrue: [ ^ digit - 55 ].
+ (digit between: "$a" 97 and: "$f" 102)
+ ifTrue: [ ^ digit - 87 ] ].
+ self error: 'hex-digit expected'
+!
+
+parseClass
+ | className |
+ className := self stringStreamContents: [ :stream |
+ [ readStream atEnd not and: [ self isClassChar: readStream peek ] ] whileTrue: [
+ stream nextPut: readStream next ] ].
+ self consumeWhitespace.
+ ^ self lookupClass: className asSymbol
+
+!
+
+parseConstantDo: block
+ "Parse and consume either true|false|nil|null and execute block
+ or else do nothing (but do not back up).
+ Hand written implementation to avoid the use of #position:"
+
+ (readStream peek = $t)
+ ifTrue: [
+ ^ self match: 'true' do: [ block value: true ] ].
+ (readStream peek = $f)
+ ifTrue: [
+ ^ self match: 'false' do: [ block value: false ] ].
+ (readStream peek = $n)
+ ifTrue: [
+ readStream next.
+ (readStream peek = $i)
+ ifTrue: [
+ self match: 'il' do: [ block value: nil ] ].
+ (readStream peek = $u)
+ ifTrue: [
+ self match: 'ull' do: [ block value: nil ] ] ]
+!
+
+parseEscapedCharacter
+ | char |
+ char := readStream next.
+ (#($' $" $/ $\) includes: char)
+ ifTrue: [ ^ char ].
+ char = $b
+ ifTrue: [ ^ Character backspace ].
+ char = $f
+ ifTrue: [ ^ Character newPage ].
+ char = $n
+ ifTrue: [ ^ Character lf ].
+ char = $r
+ ifTrue: [ ^ Character cr ].
+ char = $t
+ ifTrue: [ ^ Character tab ].
+ char = $u
+ ifTrue: [ ^ self parseCharacterHex ].
+ self error: 'invalid escape character \' , (String with: char).
+ ^ char
+!
+
+parseNumber
+ | negated number |
+ negated := readStream peekFor: $-.
+ number := self parseNumberInteger.
+ (readStream peekFor: $/)
+ ifTrue: [
+ number := Fraction numerator: number denominator: self parseNumberInteger.
+ (readStream peekFor: $s)
+ ifTrue: [ number := ScaledDecimal newFromNumber: number scale: self parseNumberInteger ] ]
+ ifFalse: [
+ (readStream peekFor: $.)
+ ifTrue: [ number := number + self parseNumberFraction ].
+ ((readStream peekFor: $e) or: [ readStream peekFor: $E ])
+ ifTrue: [ number := number * self parseNumberExponent ] ].
+ negated
+ ifTrue: [ number := number negated ].
+ self consumeWhitespace.
+ ^ number
+!
+
+parseNumberExponent
+ | number negated |
+ number := 0.
+ (negated := readStream peekFor: $-)
+ ifFalse: [ readStream peekFor: $+ ].
+ [ readStream atEnd not and: [ readStream peek isDigit ] ]
+ whileTrue: [ number := 10 * number + readStream next digitValue ].
+ negated
+ ifTrue: [ number := number negated ].
+ ^ 10 raisedTo: number
+!
+
+parseNumberFraction
+ | number power |
+ number := 0.
+ power := 1.0.
+ [ readStream atEnd not and: [ readStream peek isDigit ] ] whileTrue: [
+ number := 10 * number + readStream next digitValue.
+ power := power * 10.0 ].
+ ^ number / power
+!
+
+parseNumberInteger
+ | number |
+ number := 0.
+ [ readStream atEnd not and: [ readStream peek isDigit ] ] whileTrue: [
+ number := 10 * number + readStream next digitValue ].
+ ^ number
+!
+
+parseReference
+ | index |
+ self expectChar: $@.
+ index := self parseNumberInteger.
+ self consumeWhitespace.
+ unresolvedReferences := unresolvedReferences + 1.
+ ^ STONReference index: index
+!
+
+parseString
+ ^ self parseStringInternal
+!
+
+parseStringInternal
+ | result delimiter |
+ delimiter := readStream next.
+ (delimiter = $' or: [ delimiter = $" ])
+ ifFalse: [ self error: ''' or " expected' ].
+ result := self
+ stringStreamContents: [ :stream |
+ convertNewLines
+ ifTrue: [
+ [ readStream atEnd or: [ readStream peek = delimiter ] ]
+ whileFalse: [ self parseCharacterConvertingNewLinesOn: stream ] ]
+ ifFalse: [
+ [ readStream atEnd or: [ readStream peek = delimiter ] ]
+ whileFalse: [ stream nextPut: self parseCharacter ] ] ].
+ self expectChar: delimiter.
+ ^ result
+!
+
+parseSymbol
+ | string |
+ self expectChar: $#.
+ readStream peek = $'
+ ifTrue: [ ^ self parseStringInternal asSymbol ].
+ string := self stringStreamContents: [ :stream |
+ [ readStream atEnd not and: [ self isSimpleSymbolChar: readStream peek ] ] whileTrue: [
+ stream nextPut: readStream next ] ].
+ string isEmpty
+ ifFalse: [
+ self consumeWhitespace.
+ ^ string asSymbol ].
+ self error: 'unexpected input'
+! !
+
+!STONReader methodsFor:'private'!
+
+consumeWhitespace
+ "Strip whitespaces from the input stream."
+
+ [ readStream atEnd not and: [ readStream peek isSeparator ] ]
+ whileTrue: [ readStream next ]
+!
+
+expectChar: character
+ "Expect character and consume input and optional whitespace at the end,
+ throw an error otherwise."
+
+ (self matchChar: character)
+ ifFalse: [ self error: character asString, ' expected' ]
+!
+
+isClassChar: char
+ ^ 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_' includes: char
+!
+
+isClassStartChar: char
+ ^ 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' includes: char
+!
+
+isSimpleSymbolChar: char
+ ^char isLetter or: ['0123456789-_./' includes: char]
+!
+
+lookupClass: name
+ "name is a symbol at this point"
+ Smalltalk globals
+ at: name
+ ifPresent: [ :class | ^ class ].
+ "note that classes is an identity dictionary"
+ ^ classes
+ at: name
+ ifAbsentPut: [
+ Object allSubclasses
+ detect: [ :class | class isMeta not and: [ class stonName = name ] ]
+ ifNone: [ NotFoundError raiseWith: name ] ]
+
+ "Modified: / 20-05-2020 / 12:47:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+match: string do: block
+ "Try to read and consume string and execute block if successful.
+ Else do nothing (but do not back up)"
+
+ (string allSatisfy: [ :each | readStream peekFor: each ])
+ ifTrue: [
+ self consumeWhitespace.
+ block value ]
+!
+
+matchChar: character
+ "Tries to match character, consume input and
+ answer true if successful and consumes whitespace at the end."
+
+ ^ (readStream peekFor: character)
+ ifTrue: [
+ self consumeWhitespace.
+ true ]
+ ifFalse: [ false ]
+!
+
+newReference
+ | index reference |
+ index := objects size + 1.
+ reference := STONReference index: index.
+ objects at: index put: reference.
+ ^ reference
+!
+
+parseCharacterHex
+ | value codePoint |
+ value := self parseCharacterHex4Value.
+ (value < 16rD800 or: [ value > 16rDBFF ])
+ ifTrue: [ codePoint := value ]
+ ifFalse: [ | leadSurrogate trailSurrogate |
+ "Characters not in the Basic Multilingual Plane are encoded as a UTF-16 surrogate pair"
+ "See https://tools.ietf.org/html/rfc7159#section-7"
+ leadSurrogate := value.
+ trailSurrogate := self parseTrailingSurrogateHexEscape.
+ codePoint := (leadSurrogate - 16rD800) * 16r400 + (trailSurrogate - 16rDC00).
+ codePoint := 16r10000 + codePoint ].
+ ^ Character codePoint: codePoint
+!
+
+parseCharacterHex4Value
+ | value |
+ value := self parseCharacterHexDigit.
+ 3 timesRepeat: [
+ value := (value << 4) + self parseCharacterHexDigit ].
+ ^ value
+!
+
+parseTrailingSurrogateHexEscape
+ (readStream next = $\ and: [ readStream next = $u ])
+ ifTrue: [ ^ self parseCharacterHex4Value ]
+ ifFalse: [ self error: 'trailing surrogate hex escape expected' ]
+!
+
+processSubObjectsOf: object
+ | unresolvedReferencesCount |
+ unresolvedReferencesCount := unresolvedReferences.
+ object stonProcessSubObjects: [ :each |
+ each isStonReference
+ ifTrue: [ self resolveReference: each ]
+ ifFalse: [
+ each stonContainSubObjects
+ ifTrue: [ self processSubObjectsOf: each ]
+ ifFalse: [ each ] ] ].
+ unresolvedReferencesCount > unresolvedReferences
+ ifTrue: [ object stonPostReferenceResolution ].
+ ^ object
+!
+
+resolveReference: reference
+ unresolvedReferences := unresolvedReferences - 1.
+ ^ self resolveReferenceIndex: reference index
+!
+
+resolveReferenceIndex: index
+ ^ objects at: index
+!
+
+setReference: reference to: object
+ objects at: reference index put: object
+!
+
+storeReference: object
+ | index |
+ index := objects size + 1.
+ objects at: index put: object.
+ ^ index
+!
+
+stringStreamContents: block
+ stringStream ifNil: [
+ stringStream := (String new: 32) writeStream ].
+ stringStream reset.
+ block value: stringStream.
+ ^ stringStream contents
+! !
+
+!STONReader methodsFor:'public'!
+
+next
+ | object |
+ self consumeWhitespace.
+ object := self parseValue.
+ unresolvedReferences > 0
+ ifTrue: [ self processSubObjectsOf: object ].
+ unresolvedReferences = 0
+ ifFalse: [ self error: 'Inconsistent reference resolution' ].
+ ^ object
+! !
+
+!STONReader methodsFor:'testing'!
+
+atEnd
+ ^ readStream atEnd
+! !
+
+!STONReader class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/STONReaderError.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,38 @@
+"{ Package: 'stx:goodies/ston' }"
+
+"{ NameSpace: Smalltalk }"
+
+Error subclass:#STONReaderError
+ instanceVariableNames:'streamPosition'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Core-Reader'
+!
+
+!STONReaderError class methodsFor:'instance creation'!
+
+signal: aString streamPosition: streamPosition
+ ^ self new
+ streamPosition: streamPosition;
+ signal: aString;
+ yourself
+! !
+
+!STONReaderError methodsFor:'accessing'!
+
+messageText
+ ^ streamPosition
+ ifNil: [
+ super messageText ]
+ ifNotNil: [
+ 'At character <1P>: <2P>' expandMacrosWith: streamPosition with: super messageText ]
+!
+
+streamPosition
+ ^ streamPosition
+!
+
+streamPosition: aNumber
+ streamPosition := aNumber
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/STONReference.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,52 @@
+"{ Package: 'stx:goodies/ston' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#STONReference
+ instanceVariableNames:'index'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Core-Reader'
+!
+
+!STONReference class methodsFor:'instance creation'!
+
+index: integer
+ ^ self new
+ index: integer;
+ yourself
+! !
+
+!STONReference methodsFor:'accessing'!
+
+index
+ ^ index
+!
+
+index: integer
+ index := integer
+! !
+
+!STONReference methodsFor:'comparing'!
+
+= anObject
+ ^ self class == anObject class and: [ self index = anObject index ]
+!
+
+hash
+ ^ index hash
+! !
+
+!STONReference methodsFor:'printing'!
+
+printOn: stream
+ super printOn: stream.
+ stream nextPut: $(; print: index; nextPut: $)
+! !
+
+!STONReference methodsFor:'testing'!
+
+isStonReference
+ ^ true
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/STONShortListWriter.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,18 @@
+"{ Package: 'stx:goodies/ston' }"
+
+"{ NameSpace: Smalltalk }"
+
+STONListWriter subclass:#STONShortListWriter
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Core-Writer'
+!
+
+!STONShortListWriter methodsFor:'accessing'!
+
+add: anObject
+ first ifTrue: [ first := false ] ifFalse: [ writer shortListElementSeparator ].
+ writer nextPut: anObject
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/STONStreamWriter.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,36 @@
+"{ Package: 'stx:goodies/ston' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#STONStreamWriter
+ instanceVariableNames:'writer first'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Core-Writer'
+!
+
+!STONStreamWriter class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+!
+
+on: stonWriter
+ ^ self new
+ on: stonWriter;
+ yourself
+! !
+
+!STONStreamWriter methodsFor:'initialize-release'!
+
+initialize
+ super initialize.
+ first := true
+!
+
+on: stonWriter
+ writer := stonWriter
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/STONWriter.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,526 @@
+"{ Package: 'stx:goodies/ston' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#STONWriter
+ instanceVariableNames:'writeStream prettyPrint stonCharacters newLine asciiOnly jsonMode
+ keepNewLines referencePolicy level objects'
+ classVariableNames:'STONCharacters STONSimpleSymbolCharacters'
+ poolDictionaries:''
+ category:'STON-Core-Writer'
+!
+
+
+!STONWriter class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+!
+
+on: writeStream
+ ^ self new
+ on: writeStream;
+ yourself
+! !
+
+!STONWriter class methodsFor:'class initialization'!
+
+initialize
+ "Modification timestamp 20170131"
+
+ self initializeSTONCharacters.
+ self initializeSTONSimpleSymbolCharacters
+!
+
+initializeSTONCharacters
+ | escapes |
+ STONCharacters := Array new: 127.
+ 32 to: 126 do: [ :each |
+ STONCharacters at: each + 1 put: #pass ].
+ "This is the minimal STON set of named escapes"
+ escapes := #( 8 '\b' 9 '\t' 10 '\n' 12 '\f' 13 '\r' 39 '\''' 92 '\\' ).
+ escapes pairWiseDo: [ :code :escape |
+ STONCharacters at: code + 1 put: escape ]
+
+ "Modified: / 04-06-2019 / 10:59:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+initializeSTONSimpleSymbolCharacters
+ "STONSimpleSymbolCharacters asArray collectWithIndex: [ :each :index |
+ each isZero ifTrue: [ (index - 1) asCharacter ] ]."
+
+ STONSimpleSymbolCharacters := ByteArray new: 256 withAll: 1.
+ 1 to: 256 do: [ :each | | char |
+ char := (each - 1) asCharacter.
+ (self isSimpleSymbolChar: char)
+ ifTrue: [
+ STONSimpleSymbolCharacters at: each put: 0 ] ]
+! !
+
+!STONWriter class methodsFor:'private'!
+
+isSimpleSymbolChar: char
+ ^ 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_./' includes: char
+! !
+
+!STONWriter methodsFor:'accessing'!
+
+jsonMode
+
+ ^ jsonMode
+! !
+
+!STONWriter methodsFor:'error handling'!
+
+error: aString
+ ^ STONWriterError signal: aString
+! !
+
+!STONWriter methodsFor:'initialize-release'!
+
+asciiOnly: boolean
+ asciiOnly := boolean
+!
+
+close
+ writeStream ifNotNil: [
+ writeStream close.
+ writeStream := nil ]
+!
+
+escape: char with: anObject
+ "Instruct me to escape char with object, either a replacement string or #pass"
+
+ "self escape: $/ with: '\/'."
+
+ self assert: (anObject isString | (anObject == #pass)).
+ self assert: char codePoint < 256.
+ self writeableStonCharacters at: char codePoint + 1 put: anObject
+
+ "Modified: / 04-06-2019 / 11:12:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+initialize
+ super initialize.
+ stonCharacters := STONCharacters.
+ prettyPrint := false.
+ newLine := Character cr asString.
+ level := 0.
+ referencePolicy := #normal.
+ jsonMode := keepNewLines := asciiOnly := false.
+ objects := IdentityDictionary new
+
+ "Modified: / 04-06-2019 / 10:58:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+jsonMode: boolean
+ (jsonMode := boolean)
+ ifTrue: [
+ self
+ escape: $' with: #pass;
+ escape: $" with: '\"' ]
+ ifFalse: [
+ self
+ escape: $" with: #pass;
+ escape: $' with: '\''' ]
+!
+
+keepNewLines: boolean
+ "If true, any newline CR, LF or CRLF inside strings or symbols will not be escaped
+ but will instead be converted to the newline convention chosen, see #newLine:
+ The default is false, where CR, LF or CRLF will be enscaped unchanged."
+
+ keepNewLines := boolean
+!
+
+newLine: string
+ "The sequence to use when ending a line, either CR, LF or CRLF"
+
+ newLine := string
+!
+
+on: aWriteStream
+ writeStream := aWriteStream
+!
+
+optimizeForLargeStructures
+ self class environment
+ at: #FLLargeIdentityDictionary
+ ifPresent: [ :identityDictionaryClass | objects := identityDictionaryClass new ].
+!
+
+prettyPrint: boolean
+ prettyPrint := boolean
+!
+
+referencePolicy: policy
+ self assert: ( #(#normal #ignore #error) includes: policy ).
+ referencePolicy := policy
+!
+
+reset
+ objects removeAll
+! !
+
+!STONWriter methodsFor:'private'!
+
+encodeCharacter: char
+ | code encoding |
+ "STONCharacters contains for the lower 127 characters (codes 0 to 126) either nil (unknown),
+ #pass (output as is, clean ASCII characters) or a full escape string"
+ ((code := char codePoint) < 127 and: [ (encoding := self stonCharacters at: code + 1) notNil ])
+ ifTrue: [
+ (encoding = #pass or: [ jsonMode and: [ char = $' ] ])
+ ifTrue: [ writeStream nextPut: char ]
+ ifFalse: [ writeStream nextPutAll: encoding ] ]
+ ifFalse: [
+ "always escape Latin1 C1 controls, or when asciiOnly is true"
+ (code > 16r9F and: [ asciiOnly not ])
+ ifTrue: [ writeStream nextPut: char ]
+ ifFalse: [ self escapeUnicode: code ] ]
+!
+
+encodeKey: key value: value
+ (jsonMode and: [ key isString not ])
+ ifTrue: [ self error: 'JSON key names in objects must be strings' ].
+ self nextPut: key.
+ self prettyPrintSpace.
+ writeStream nextPut: $:.
+ self prettyPrintSpace.
+ self nextPut: value
+!
+
+encodeString: string
+ writeStream nextPut: (jsonMode ifTrue: [ $" ] ifFalse: [ $' ]).
+ keepNewLines
+ ifTrue: [
+ self encodeStringKeepingNewLines: string ]
+ ifFalse: [
+ string do: [ :each | self encodeCharacter: each ] ].
+ writeStream nextPut: (jsonMode ifTrue: [ $" ] ifFalse: [ $' ])
+!
+
+encodeStringKeepingNewLines: string
+ | input char |
+ input := string readStream.
+ [ input atEnd ]
+ whileFalse: [
+ char := input next.
+ char = Character lf
+ ifTrue: [ writeStream nextPutAll: newLine ]
+ ifFalse: [
+ char = Character cr
+ ifTrue: [
+ input peekFor: Character lf.
+ writeStream nextPutAll: newLine ]
+ ifFalse: [ self encodeCharacter: char ] ] ]
+!
+
+escapeUnicode4: codePoint
+ writeStream nextPutAll: '\u'.
+ codePoint printOn: writeStream base: 16 nDigits: 4
+!
+
+escapeUnicode: codePoint
+ codePoint <= 16rFFFF
+ ifTrue: [ self escapeUnicode4: codePoint ]
+ ifFalse: [
+ codePoint <= 16r10FFFF
+ ifTrue: [ | leadSurrogate trailSurrogate shifted |
+ "Characters not in the Basic Multilingual Plane are encoded as a UTF-16 surrogate pair"
+ "See https://tools.ietf.org/html/rfc7159#section-7"
+ shifted := codePoint - 16r10000.
+ leadSurrogate := 16rD800 + (shifted // 16r400).
+ trailSurrogate := 16rDC00 + (shifted \\ 16r400).
+ self escapeUnicode4: leadSurrogate.
+ self escapeUnicode4: trailSurrogate ]
+ ifFalse: [ self error: 'Character Unicode code point outside encoder range' ] ]
+!
+
+indentedDo: block
+ level := level + 1.
+ block value.
+ level := level - 1
+!
+
+isSimpleSymbol: symbol
+ symbol isEmpty ifTrue: [ ^ false ].
+ ^ (symbol class
+ findFirstInString: symbol
+ inSet: STONSimpleSymbolCharacters
+ startingAt: 1) = 0
+!
+
+listElementSeparator
+ writeStream nextPut: $,.
+ self newlineIndent
+!
+
+mapElementSeparator
+ writeStream nextPut: $,.
+ self newlineIndent
+!
+
+newlineIndent
+ prettyPrint ifTrue: [
+ writeStream nextPutAll: newLine.
+ level timesRepeat: [ writeStream tab ] ]
+!
+
+prettyPrintSpace
+ prettyPrint ifTrue: [ writeStream space ]
+!
+
+shortListElementSeparator
+ writeStream nextPut: $,.
+ self prettyPrintSpace
+!
+
+stonCharacters
+ ^ stonCharacters ifNil: [ stonCharacters := STONCharacters ]
+!
+
+with: object do: block
+ | index |
+ referencePolicy = #ignore
+ ifTrue: [ ^ block value ].
+ (index := objects at: object ifAbsent: [ nil ]) notNil
+ ifTrue: [
+ referencePolicy = #error
+ ifTrue: [ ^ self error: 'shared reference detected' ].
+ self writeReference: index ]
+ ifFalse: [
+ index := objects size + 1.
+ objects at: object put: index.
+ block value ]
+!
+
+writeableStonCharacters
+ ^ self stonCharacters == STONCharacters
+ ifTrue: [ stonCharacters := stonCharacters copy ]
+ ifFalse: [ stonCharacters ]
+! !
+
+!STONWriter methodsFor:'public'!
+
+nextPut: anObject
+ anObject stonOn: self
+! !
+
+!STONWriter methodsFor:'writing'!
+
+encodeList: elements
+ writeStream nextPut: $[.
+ elements isEmpty
+ ifTrue: [
+ self prettyPrintSpace ]
+ ifFalse: [
+ self indentedDo: [
+ self newlineIndent.
+ elements
+ do: [ :each | self nextPut: each ]
+ separatedBy: [ self listElementSeparator ] ].
+ self newlineIndent ].
+ writeStream nextPut: $]
+!
+
+encodeMap: pairs
+ | first |
+ first := true.
+ writeStream nextPut: ${.
+ pairs isEmpty
+ ifTrue: [
+ self prettyPrintSpace ]
+ ifFalse: [
+ self indentedDo: [
+ self newlineIndent.
+ pairs keysAndValuesDo: [ :key :value |
+ first
+ ifTrue: [ first := false ]
+ ifFalse: [ self mapElementSeparator ].
+ self encodeKey: key value: value ] ].
+ self newlineIndent ].
+ writeStream nextPut: $}
+!
+
+writeAssociation: association
+ jsonMode
+ ifTrue: [ self error: 'wrong object class for JSON mode' ].
+ self
+ encodeKey: association key
+ value: association value
+!
+
+writeBoolean: boolean
+ writeStream print: boolean
+!
+
+writeFloat: float
+ writeStream print: float
+!
+
+writeFraction: fraction
+ jsonMode
+ ifTrue: [ self writeFloat: fraction asFloat ]
+ ifFalse: [ writeStream
+ print: fraction numerator;
+ nextPut: $/;
+ print: fraction denominator ]
+!
+
+writeInteger: integer
+ writeStream print: integer
+!
+
+writeList: collection
+ self with: collection do: [
+ self encodeList: collection ]
+!
+
+writeMap: hashedCollection
+ self with: hashedCollection do: [
+ self encodeMap: hashedCollection ]
+!
+
+writeNull
+ jsonMode
+ ifTrue: [ writeStream nextPutAll: 'null' ]
+ ifFalse: [ writeStream print: nil ]
+!
+
+writeObject: anObject
+ | instanceVariableNames |
+ (instanceVariableNames := anObject class stonAllInstVarNames) isEmpty
+ ifTrue: [
+ self writeObject: anObject do: [ self encodeMap: #() ] ]
+ ifFalse: [
+ self writeObject: anObject streamMap: [ :dictionary |
+ instanceVariableNames do: [ :each |
+ | value |
+
+ (value := anObject instVarNamed: each) notNil
+ ifTrue: [
+ dictionary at: each asSymbol put: value ]
+ ifFalse: [
+ anObject stonShouldWriteNilInstVars
+ ifTrue: [ dictionary at: each asSymbol put: nil ] ] ] ] ]
+!
+
+writeObject: anObject do: block
+ (jsonMode and: [ anObject class ~= STON listClass and: [ anObject class ~= STON mapClass and: [anObject class ~= ImmutableArray ] ] ])
+ ifTrue: [ self error: 'wrong object class for JSON mode' ].
+ self with: anObject do: [
+ writeStream nextPutAll: anObject class stonName.
+ self prettyPrintSpace.
+ block value ]
+
+ "Modified: / 20-05-2020 / 11:07:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+writeObject: object listSingleton: element
+ self writeObject: object do: [
+ writeStream nextPut: $[.
+ self
+ prettyPrintSpace;
+ nextPut: element;
+ prettyPrintSpace.
+ writeStream nextPut: $] ]
+!
+
+writeObject: anObject named: stonName do: block
+ (jsonMode and: [ anObject class ~= STON listClass and: [ anObject class ~= STON mapClass ] ])
+ ifTrue: [ self error: 'wrong object class for JSON mode' ].
+ self with: anObject do: [
+ writeStream nextPutAll: stonName.
+ self prettyPrintSpace.
+ block value ]
+!
+
+writeObject: object named: stonName listSingleton: element
+ self writeObject: object named: stonName do: [
+ writeStream nextPut: $[.
+ self
+ prettyPrintSpace;
+ nextPut: element;
+ prettyPrintSpace.
+ writeStream nextPut: $] ]
+!
+
+writeObject: object streamList: block
+ self writeObject: object do: [ | listWriter |
+ listWriter := STONListWriter on: self.
+ writeStream nextPut: $[.
+ self indentedDo: [
+ self newlineIndent.
+ block value: listWriter ].
+ self newlineIndent.
+ writeStream nextPut: $] ]
+!
+
+writeObject: object streamMap: block
+ self writeObject: object do: [ | mapWriter |
+ mapWriter := STONMapWriter on: self.
+ writeStream nextPut: ${.
+ self indentedDo: [
+ self newlineIndent.
+ block value: mapWriter ].
+ self newlineIndent.
+ writeStream nextPut: $} ]
+!
+
+writeObject: object streamShortList: block
+ self writeObject: object do: [ | listWriter |
+ listWriter := STONShortListWriter on: self.
+ writeStream nextPut: $[.
+ self indentedDo: [
+ self prettyPrintSpace.
+ block value: listWriter ].
+ self prettyPrintSpace.
+ writeStream nextPut: $] ]
+!
+
+writeReference: index
+ writeStream
+ nextPut: $@;
+ print: index
+!
+
+writeScaledDecimal: scaledDecimal
+ jsonMode
+ ifTrue: [ self writeFloat: scaledDecimal asFloat ]
+ ifFalse: [ writeStream
+ print: scaledDecimal numerator;
+ nextPut: $/;
+ print: scaledDecimal denominator;
+ nextPut: $s;
+ print: scaledDecimal scale ]
+!
+
+writeString: string
+ self encodeString: string
+!
+
+writeSymbol: symbol
+ jsonMode
+ ifTrue: [
+ self writeString: symbol ]
+ ifFalse: [
+ writeStream nextPut: $#.
+ (self isSimpleSymbol: symbol)
+ ifTrue: [
+ writeStream nextPutAll: symbol ]
+ ifFalse: [
+ self encodeString: symbol ] ]
+! !
+
+!STONWriter class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
+
+STONWriter initialize!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/STONWriterError.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,11 @@
+"{ Package: 'stx:goodies/ston' }"
+
+"{ NameSpace: Smalltalk }"
+
+Error subclass:#STONWriterError
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Core-Writer'
+!
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/abbrev.stc Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,17 @@
+# automagically generated by the project definition
+# this file is needed for stc to be able to compile modules independently.
+# it provides information about a classes filename, category and especially namespace.
+STON STON stx:goodies/ston 'STON-Core-Facade' 0
+STONCStyleCommentsSkipStream STONCStyleCommentsSkipStream stx:goodies/ston 'STON-Core-Reader' 0
+STONFileReference STONFileReference stx:goodies/ston 'STON-Core-Reader' 0
+STONJSON STONJSON stx:goodies/ston 'STON-Core-Facade' 0
+STONReader STONReader stx:goodies/ston 'STON-Core-Reader' 0
+STONReaderError STONReaderError stx:goodies/ston 'STON-Core-Reader' 1
+STONReference STONReference stx:goodies/ston 'STON-Core-Reader' 0
+STONStreamWriter STONStreamWriter stx:goodies/ston 'STON-Core-Writer' 0
+STONWriter STONWriter stx:goodies/ston 'STON-Core-Writer' 0
+STONWriterError STONWriterError stx:goodies/ston 'STON-Core-Writer' 1
+stx_goodies_ston stx_goodies_ston stx:goodies/ston '* Projects & Packages *' 3
+STONListWriter STONListWriter stx:goodies/ston 'STON-Core-Writer' 0
+STONMapWriter STONMapWriter stx:goodies/ston 'STON-Core-Writer' 0
+STONShortListWriter STONShortListWriter stx:goodies/ston 'STON-Core-Writer' 0
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bc.mak Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,104 @@
+# $Header$
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: stx_goodies_ston.
+#
+# Warning: once you modify this file, do not rerun
+# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
+#
+# Notice, that the name bc.mak is historical (from times, when only borland c was supported).
+# This file contains make rules for the win32 platform using either borland-bcc or visual-c.
+# It shares common definitions with the unix-make in Make.spec.
+# The bc.mak supports the following targets:
+# bmake - compile all st-files to a classLib (dll)
+# bmake clean - clean all temp files
+# bmake clobber - clean all
+#
+# Historic Note:
+# this used to contain only rules to make with borland
+# (called via bmake, by "make.exe -f bc.mak")
+# this has changed; it is now also possible to build using microsoft visual c
+# (called via vcmake, by "make.exe -f bc.mak -DUSEVC")
+#
+TOP=..\..
+INCLUDE_TOP=$(TOP)\..
+
+
+
+!INCLUDE $(TOP)\rules\stdHeader_bc
+
+!INCLUDE Make.spec
+
+LIBNAME=libstx_goodies_ston
+MODULE_PATH=goodies\ston
+RESFILES=stx_goodies_stonWINrc.$(RES)
+
+
+
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2 -I$(INCLUDE_TOP)\stx\libcompat -I$(INCLUDE_TOP)\stx\libhtml -I$(INCLUDE_TOP)\stx\libview
+LOCALDEFINES=
+
+STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
+LOCALLIBS=
+
+OBJS= $(COMMON_OBJS) $(WIN32_OBJS)
+
+ALL:: classLibRule
+
+classLibRule: $(OUTDIR) $(OUTDIR)$(LIBNAME).dll
+
+!INCLUDE $(TOP)\rules\stdRules_bc
+
+# build all mandatory prerequisite packages (containing superclasses) for this package
+prereq:
+ pushd ..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\libwidg & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\libhtml & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\libwidg2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\libcompat & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+
+
+
+
+
+
+
+test: $(TOP)\goodies\builder\reports
+ pushd $(TOP)\goodies\builder\reports & $(MAKE_BAT)
+ $(TOP)\goodies\builder\reports\report-runner.bat -D . -r Builder::TestReport -p $(PACKAGE)
+
+clean::
+ -del *.$(CSUFFIX)
+
+
+# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)STON.$(O) STON.$(C) STON.$(H): STON.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONCStyleCommentsSkipStream.$(O) STONCStyleCommentsSkipStream.$(C) STONCStyleCommentsSkipStream.$(H): STONCStyleCommentsSkipStream.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONFileReference.$(O) STONFileReference.$(C) STONFileReference.$(H): STONFileReference.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libcompat\FileReference.$(H) $(STCHDR)
+$(OUTDIR)STONJSON.$(O) STONJSON.$(C) STONJSON.$(H): STONJSON.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONReader.$(O) STONReader.$(C) STONReader.$(H): STONReader.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONReaderError.$(O) STONReaderError.$(C) STONReaderError.$(H): STONReaderError.st $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONReference.$(O) STONReference.$(C) STONReference.$(H): STONReference.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONStreamWriter.$(O) STONStreamWriter.$(C) STONStreamWriter.$(H): STONStreamWriter.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONWriter.$(O) STONWriter.$(C) STONWriter.$(H): STONWriter.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONWriterError.$(O) STONWriterError.$(C) STONWriterError.$(H): STONWriterError.st $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)stx_goodies_ston.$(O) stx_goodies_ston.$(C) stx_goodies_ston.$(H): stx_goodies_ston.st $(INCLUDE_TOP)\stx\libbasic\LibraryDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProjectDefinition.$(H) $(STCHDR)
+$(OUTDIR)STONListWriter.$(O) STONListWriter.$(C) STONListWriter.$(H): STONListWriter.st $(INCLUDE_TOP)\stx\goodies\ston\STONStreamWriter.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONMapWriter.$(O) STONMapWriter.$(C) STONMapWriter.$(H): STONMapWriter.st $(INCLUDE_TOP)\stx\goodies\ston\STONStreamWriter.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONShortListWriter.$(O) STONShortListWriter.$(C) STONShortListWriter.$(H): STONShortListWriter.st $(INCLUDE_TOP)\stx\goodies\ston\STONListWriter.$(H) $(INCLUDE_TOP)\stx\goodies\ston\STONStreamWriter.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)\stx\libbasic\AbstractTime.$(H) $(INCLUDE_TOP)\stx\libbasic\ArithmeticValue.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Association.$(H) $(INCLUDE_TOP)\stx\libbasic\Bag.$(H) $(INCLUDE_TOP)\stx\libbasic\Behavior.$(H) $(INCLUDE_TOP)\stx\libbasic\Boolean.$(H) $(INCLUDE_TOP)\stx\libbasic\ByteArray.$(H) $(INCLUDE_TOP)\stx\libbasic\Character.$(H) $(INCLUDE_TOP)\stx\libbasic\CharacterArray.$(H) $(INCLUDE_TOP)\stx\libbasic\Class.$(H) $(INCLUDE_TOP)\stx\libbasic\ClassDescription.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Date.$(H) $(INCLUDE_TOP)\stx\libbasic\Dictionary.$(H) $(INCLUDE_TOP)\stx\libbasic\Filename.$(H) $(INCLUDE_TOP)\stx\libbasic\Fraction.$(H) $(INCLUDE_TOP)\stx\libbasic\Integer.$(H) $(INCLUDE_TOP)\stx\libbasic\Interval.$(H) $(INCLUDE_TOP)\stx\libbasic\LookupKey.$(H) $(INCLUDE_TOP)\stx\libbasic\Magnitude.$(H) $(INCLUDE_TOP)\stx\libbasic\Metaclass.$(H) $(INCLUDE_TOP)\stx\libbasic\Number.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\OrderedDictionary.$(H) $(INCLUDE_TOP)\stx\libbasic\Point.$(H) $(INCLUDE_TOP)\stx\libbasic\ReadOnlySequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Set.$(H) $(INCLUDE_TOP)\stx\libbasic\String.$(H) $(INCLUDE_TOP)\stx\libbasic\Symbol.$(H) $(INCLUDE_TOP)\stx\libbasic\Time.$(H) $(INCLUDE_TOP)\stx\libbasic\Timestamp.$(H) $(INCLUDE_TOP)\stx\libbasic\UndefinedObject.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(INCLUDE_TOP)\stx\libbasic2\RunArray.$(H) $(INCLUDE_TOP)\stx\libhtml\URL.$(H) $(INCLUDE_TOP)\stx\libview\Color.$(H) $(STCHDR)
+
+# ENDMAKEDEPEND --- do not remove this line
+
+# **Must be at end**
+
+# Enforce recompilation of package definition class if Mercurial working
+# copy state changes. Together with --guessVersion it ensures that package
+# definition class always contains correct binary revision string.
+!IFDEF HGROOT
+$(OUTDIR)stx_goodies_ston.$(O): $(HGROOT)\.hg\dirstate
+!ENDIF
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bmake.bat Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,15 @@
+@REM -------
+@REM make using Borland bcc32
+@REM type bmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
+make.exe -N -f bc.mak %DEFINES% %*
+
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/extensions.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,654 @@
+"{ Package: 'stx:goodies/ston' }"!
+
+!Association methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ self class == STON associationClass
+ ifTrue: [ stonWriter writeAssociation: self ]
+ ifFalse: [ super stonOn: stonWriter ]
+
+! !
+
+!Bag methodsFor:'*STON-Core'!
+
+stonOn: stonWriter
+ "Use a map with element-occurences pairs as representation"
+
+ stonWriter
+ writeObject: self
+ do: [ stonWriter encodeMap: contents ]
+! !
+
+!Bag class methodsFor:'*STON-Core'!
+
+fromSton: stonReader
+ "Read a map representation containing element/occurences pairs"
+
+ | bag |
+ bag := self new.
+ stonReader parseMapDo: [ :key :value |
+ bag add: key withOccurrences: value ].
+ ^ bag
+! !
+
+!Boolean methodsFor:'*ston-core'!
+
+stonContainSubObjects
+ ^ false
+! !
+
+!Boolean methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ stonWriter writeBoolean: self
+! !
+
+!ByteArray methodsFor:'*ston-core'!
+
+stonContainSubObjects
+ ^ false
+! !
+
+!ByteArray methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ "Use a hex representation"
+
+ stonWriter writeObject: self listSingleton: self hexPrintString
+
+ "Modified: / 04-06-2019 / 11:06:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ByteArray class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ "Use a hex representation"
+
+ ^ self fromHexString: stonReader parseListSingleton
+
+ "Modified: / 04-06-2019 / 11:07:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!Character methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ stonWriter writeObject: self listSingleton: self asString
+! !
+
+!Character class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ ^ stonReader parseListSingleton first
+! !
+
+!CharacterArray class methodsFor:'Compatibility-Pharo'!
+
+findFirstInString: aString inSet: inclusionMap startingAt: start
+ | i stringSize |
+
+ inclusionMap size ~= 256 ifTrue: [ ^0 ].
+
+ i := start.
+ stringSize := aString size.
+ [ i <= stringSize and: [ (inclusionMap at: (aString basicAt: i) codePoint + 1) = 0 ] ] whileTrue: [
+ i := i + 1 ].
+
+ i > stringSize ifTrue: [ ^0 ].
+ ^i
+
+ "Created: / 20-05-2020 / 13:24:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!Class methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ stonWriter
+ writeObject: self
+ listSingleton: self name asSymbol
+! !
+
+!Class class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ | theClassName theClass |
+ theClassName := stonReader parseListSingleton.
+ theClass := self environment at: theClassName.
+ ^ theClass
+! !
+
+!ClassDescription methodsFor:'*ston-core'!
+
+stonContainSubObjects
+ ^ false
+! !
+
+!Collection methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ "For collections we chose to write a list of elements as delivered by #do:
+ This is not the best or most correct solution for all subclasses though,
+ so some will revert to standard object behavior or chose another solution"
+
+ stonWriter writeObject: self do: [
+ stonWriter encodeList: self ]
+! !
+
+!Collection class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ "For collections we chose to instanciate based a list of elements using #add:
+ This is not the best or most correct solution for all subclasses though,
+ so some will revert to standard object behavior or chose another solution."
+
+ | collection |
+ collection := self new.
+ stonReader parseListDo: [ :each |
+ collection add: each ].
+ ^ collection
+! !
+
+!Color methodsFor:'*ston-core'!
+
+stonContainSubObjects
+ ^ false
+! !
+
+!Color methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ | name |
+ (self isTranslucent or: [ (name := self name) = nil ])
+ ifTrue: [
+ stonWriter writeObject: self streamMap: [ :map |
+ #(red green blue alpha) do: [ :each |
+ map at: each put: ((self perform: each) roundTo: 0.001) ] ] ]
+ ifFalse: [
+ stonWriter writeObject: self listSingleton: name ]
+
+ "Modified: / 20-05-2020 / 13:27:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!Color class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ | representation |
+ representation := stonReader parseSimpleValue.
+ ^ representation isArray
+ ifTrue: [
+ self name: representation first ]
+ ifFalse: [
+ self
+ r: (representation at: #red)
+ g: (representation at: #green)
+ b: (representation at: #blue)
+ alpha: (representation at: #alpha) ]
+
+ "Modified: / 20-05-2020 / 12:22:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!Date methodsFor:'*ston-core'!
+
+stonContainSubObjects
+ ^ false
+! !
+
+!Date methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ "Use an ISO style YYYY-MM-DD representation.
+ Since my current implementation is time zone offset sensitive, the offset has to be included."
+
+ | representation |
+ representation := self offset isZero
+ ifTrue: [
+ String new: 11 streamContents: [ :out |
+ self printOn: out format: #(3 2 1 $- 1 1 2).
+ out nextPut: $Z ] ]
+ ifFalse: [
+ String new: 32 streamContents: [ :out |
+ self printOn: out format: #(3 2 1 $- 1 1 2).
+ out nextPut: (self offset positive ifTrue: [ $+ ] ifFalse: [ $- ]).
+ self offset hours abs printOn: out base: 10 length: 2 padded: true.
+ out nextPut: $:.
+ self offset minutes abs printOn: out base: 10 length: 2 padded: true.
+ self offset seconds = 0
+ ifFalse:[
+ out nextPut: $:; print: self offset seconds abs truncated ] ] ].
+ stonWriter writeObject: self listSingleton: representation
+! !
+
+!Date class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ "Read a ISO YYYY-MM-DD format.
+ Since my current implementation is time zone offset sensitive, the offset has to be taken into account.
+ A missing offset results in the local timezone offset to be used"
+
+ | readStream date |
+ readStream := stonReader parseListSingleton readStream.
+ date := self readFrom: readStream.
+ readStream atEnd
+ ifFalse: [ | offset |
+ offset := DateAndTime readTimezoneOffsetFrom: readStream.
+ offset = date offset
+ ifFalse: [ date start: (date start translateTo: offset) ] ].
+ ^ date
+! !
+
+!Dictionary methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ "Instances of STON mapClass will be encoded directly, without a class tag.
+ Other (sub)classes will be encoded with a class tag and will use a map representation. "
+
+ self class == STON mapClass
+ ifTrue: [
+ stonWriter writeMap: self ]
+ ifFalse: [
+ stonWriter
+ writeObject: self
+ do: [ stonWriter encodeMap: self ] ]
+! !
+
+!Dictionary methodsFor:'*ston-core'!
+
+stonPostReferenceResolution
+ "When references were resolved in me, the hash of my keys might have changed.
+ Check if I am still healthy and rehash me if not."
+
+ self rehash
+
+ "Modified: / 04-06-2019 / 11:08:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!Dictionary class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ "Instances of STON mapClass will be read directly and won't arrive here.
+ Other (sub)classes will use this method."
+
+ | dictionary |
+ dictionary := self new.
+ stonReader parseMapDo: [ :key :value |
+ dictionary at: key put: value ].
+ ^ dictionary
+! !
+
+!Filename methodsFor:'*ston-core'!
+
+stonContainSubObjects
+ ^ false
+! !
+
+!Filename methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ true
+ ifTrue: [ | diskFilePath |
+ diskFilePath := self pathName.
+ stonWriter
+ writeObject: self
+ named: STONFileReference stonName
+ listSingleton: diskFilePath ]
+ ifFalse: [
+ super stonOn: stonWriter ]
+
+ "Modified: / 04-06-2019 / 12:31:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!Fraction methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ stonWriter writeFraction: self
+! !
+
+!Integer methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ stonWriter writeInteger: self
+! !
+
+!Interval methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ "Overwritten to get back the standard object behavior"
+
+ stonReader parseNamedInstVarsFor: self
+! !
+
+!Interval methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ "Overwritten to get back the standard object behavior"
+
+ stonWriter writeObject: self
+! !
+
+!Interval class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ "Overwritten to get back the standard object behavior"
+
+ ^ self new
+ fromSton: stonReader;
+ yourself
+! !
+
+!Metaclass methodsFor:'*ston-core'!
+
+stonName
+ ^ #Class
+! !
+
+!Metaclass methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ stonWriter
+ writeObject: self
+ listSingleton: self theNonMetaclass name asSymbol
+
+ "Modified: / 04-06-2019 / 11:20:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!Metaclass class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ | theClassName theClass theMetaclass |
+ theClassName := stonReader parseListSingleton.
+ theClass := self environment at: theClassName.
+ theMetaclass := theClass class.
+ ^ theMetaclass
+! !
+
+!Number methodsFor:'*ston-core'!
+
+stonContainSubObjects
+ ^ false
+! !
+
+!Number methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ stonWriter writeFloat: self asFloat
+! !
+
+!Object methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ "Decode non-variable classes from a map of their instance variables and values.
+ Override to customize and add a matching #toSton: (see implementors)."
+
+ self class isVariable
+ ifTrue: [
+ stonReader error: 'custom #fromSton: implementation needed for variable/indexable class' ]
+ ifFalse: [
+ stonReader parseNamedInstVarsFor: self ]
+! !
+
+!Object methodsFor:'*ston-core'!
+
+isStonReference
+ ^ false
+! !
+
+!Object methodsFor:'*ston-core'!
+
+stonContainSubObjects
+ "Return true if I contain subObjects that should be processed, false otherwise.
+ Overwrite when necessary. See also #stonProcessSubObjects:"
+
+ ^ true
+! !
+
+!Object methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ "Encode non-variable classes with a map of their instance variable and values.
+ Override to customize and add a matching #fromSton: (see implementors)."
+
+ self class isVariable
+ ifTrue: [
+ stonWriter error: 'custom #stonOn: implementation needed for variable/indexable class' ]
+ ifFalse: [
+ stonWriter writeObject: self ]
+! !
+
+!Object methodsFor:'*ston-core'!
+
+stonPostReferenceResolution
+ "Hook that is called when references were resolved processing this object or one of its sub objects. This will most probably influence hash values. Override to take appropriate action."
+! !
+
+!Object methodsFor:'*ston-core'!
+
+stonProcessSubObjects: block
+ "Execute block to (potentially) change each of my subObjects.
+ In general, all instance and indexable variables are processed.
+ Overwrite when necessary. Not used when #stonContainSubObjects returns false."
+
+ 1 to: self class instSize do: [ :each |
+ self instVarAt: each put: (block value: (self instVarAt: each)) ].
+ (self class isVariable and: [ self class isBytes not ])
+ ifTrue: [
+ 1 to: self basicSize do: [ :each |
+ self basicAt: each put: (block value: (self basicAt: each)) ] ]
+! !
+
+!Object methodsFor:'*ston-core'!
+
+stonShouldWriteNilInstVars
+ "Return true if my instance variables that are nil should be written out,
+ false otherwise. Overwrite when necessary. By default, return false."
+
+ ^ false
+! !
+
+!Object class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ "Create a new instance and delegate decoding to instance side.
+ Override only when new instance should be created directly (see implementors). "
+
+ ^ self new
+ fromSton: stonReader;
+ yourself
+! !
+
+!Object class methodsFor:'*ston-core'!
+
+stonAllInstVarNames
+ "Override to encode my instances using a custom set of instance variables or to define their order."
+
+ ^ self allInstVarNames
+! !
+
+!Object class methodsFor:'*ston-core'!
+
+stonName
+ "Override to encode my instances using a different class name.
+ Use symbols as class name/tag."
+
+ ^ self name
+! !
+
+!OrderedDictionary methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ "I store my instances as maps. When in JSON mode,
+ encode me directly, without a class tag, keeping the order."
+
+ stonWriter jsonMode
+ ifTrue: [
+ stonWriter encodeMap: self ]
+ ifFalse: [
+ stonWriter
+ writeObject: self
+ do: [ stonWriter encodeMap: self ] ]
+! !
+
+!OrderedDictionary class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ "My instances are stored as maps."
+
+ | dictionary |
+ dictionary := self new.
+ stonReader parseMapDo: [ :key :value |
+ dictionary at: key put: value ].
+ ^ dictionary
+! !
+
+!Point methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ stonReader parseListDo: [ :each :index |
+ index = 1 ifTrue: [ x := each ].
+ index = 2 ifTrue: [ y := each ] ]
+! !
+
+!Point methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ stonWriter writeObject: self streamShortList: [ :array |
+ array add: x; add: y ]
+! !
+
+!RunArray class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ "Overwritten to get back the standard object behavior"
+
+ ^ self new
+ fromSton: stonReader;
+ yourself
+! !
+
+!SequenceableCollection methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ "Instances of STON listClass will be encoded directly, without a class tag.
+ Other (sub)classes will be encoded with a class tag and will use a list representation. "
+
+ ((self class == STON listClass) or:[ self class == ImmutableArray ])
+ ifTrue: [ stonWriter writeList: self ]
+ ifFalse: [ super stonOn: stonWriter ]
+
+ "Modified: / 20-05-2020 / 11:19:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SequenceableCollection class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ "Overwritten to use #streamContents: and #nextPut:"
+
+ ^ self streamContents: [ :stream |
+ stonReader parseListDo: [ :each |
+ stream nextPut: each ] ]
+! !
+
+!Set methodsFor:'*ston-core'!
+
+stonPostReferenceResolution
+ "When references were resolved in me, the hash of my elements might have changed.
+ Check if I am still healthy and rehash me if not."
+
+ self rehash
+
+ "Modified: / 04-06-2019 / 11:18:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!String methodsFor:'*ston-core'!
+
+stonContainSubObjects
+ ^ false
+! !
+
+!String methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ stonWriter writeString: self
+! !
+
+!Symbol methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ stonWriter writeSymbol: self
+! !
+
+!Time methodsFor:'*ston-core'!
+
+stonContainSubObjects
+ ^ false
+! !
+
+!Time methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ "Use an ISO style HH:MM:SS.N representation (with optional nanoseconds)"
+
+ stonWriter writeObject: self listSingleton:
+ (String streamContents: [ :stream |
+ self print24: true showSeconds: true on: stream ])
+! !
+
+!Time class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ ^ self readFrom: stonReader parseListSingleton readStream
+! !
+
+!Timestamp methodsFor:'*ston-core'!
+
+stonContainSubObjects
+ ^ false
+! !
+
+!Timestamp methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ "Use an ISO representation with all details YYYY-MM-DDTHH:MM:SS.N+TZ (with optional nanoseconds and timezone offset)"
+
+ stonWriter writeObject: self listSingleton:
+ (String streamContents: [ :stream |
+ self printOn: stream withLeadingSpace: false ])
+! !
+
+!Timestamp class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ ^ self readFrom: stonReader parseListSingleton readStream
+! !
+
+!URL class methodsFor:'*ston-core'!
+
+fromSton: stonReader
+ | representation |
+
+ representation := stonReader parseSimpleValue.
+ representation isArray ifTrue:[
+ ^ representation first asURL
+ ] ifFalse:[
+ self error: 'Not yet supported'
+ ].
+
+ "Created: / 20-05-2020 / 11:54:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!UndefinedObject methodsFor:'*ston-core'!
+
+stonContainSubObjects
+ ^ false
+! !
+
+!UndefinedObject methodsFor:'*ston-core'!
+
+stonOn: stonWriter
+ stonWriter writeNull
+! !
+
+!stx_goodies_ston class methodsFor:'documentation'!
+
+extensionsVersion_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/libInit.cc Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,64 @@
+/*
+ * $Header$
+ *
+ * DO NOT EDIT
+ * automagically generated from the projectDefinition: stx_goodies_ston.
+ */
+#define __INDIRECTVMINITCALLS__
+#include <stc.h>
+
+#ifdef WIN32
+# pragma codeseg INITCODE "INITCODE"
+#endif
+
+#if defined(INIT_TEXT_SECTION) || defined(DLL_EXPORT)
+DLL_EXPORT void _libstx_goodies_ston_Init() INIT_TEXT_SECTION;
+DLL_EXPORT void _libstx_goodies_ston_InitDefinition() INIT_TEXT_SECTION;
+#endif
+
+extern void _STON_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONCStyleCommentsSkipStream_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONFileReference_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONJSON_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONReader_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONReaderError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONReference_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONStreamWriter_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONWriter_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONWriterError_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _stx_137goodies_137ston_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONListWriter_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONMapWriter_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONShortListWriter_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+
+extern void _stx_137goodies_137ston_extensions_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+
+void _libstx_goodies_ston_InitDefinition(int pass, struct __vmData__ *__pRT__, OBJ snd)
+{
+ __BEGIN_PACKAGE2__("libstx_goodies_ston__DFN", _libstx_goodies_ston_InitDefinition, "stx:goodies/ston");
+ _stx_137goodies_137ston_Init(pass,__pRT__,snd);
+
+ __END_PACKAGE__();
+}
+
+void _libstx_goodies_ston_Init(int pass, struct __vmData__ *__pRT__, OBJ snd)
+{
+ __BEGIN_PACKAGE2__("libstx_goodies_ston", _libstx_goodies_ston_Init, "stx:goodies/ston");
+ _STON_Init(pass,__pRT__,snd);
+ _STONCStyleCommentsSkipStream_Init(pass,__pRT__,snd);
+ _STONFileReference_Init(pass,__pRT__,snd);
+ _STONJSON_Init(pass,__pRT__,snd);
+ _STONReader_Init(pass,__pRT__,snd);
+ _STONReaderError_Init(pass,__pRT__,snd);
+ _STONReference_Init(pass,__pRT__,snd);
+ _STONStreamWriter_Init(pass,__pRT__,snd);
+ _STONWriter_Init(pass,__pRT__,snd);
+ _STONWriterError_Init(pass,__pRT__,snd);
+ _stx_137goodies_137ston_Init(pass,__pRT__,snd);
+ _STONListWriter_Init(pass,__pRT__,snd);
+ _STONMapWriter_Init(pass,__pRT__,snd);
+ _STONShortListWriter_Init(pass,__pRT__,snd);
+
+ _stx_137goodies_137ston_extensions_Init(pass,__pRT__,snd);
+ __END_PACKAGE__();
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/mingwmake.bat Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,18 @@
+@REM -------
+@REM make using mingw gnu compiler
+@REM type mingwmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
+@pushd ..\..\rules
+@call find_mingw.bat
+@popd
+make.exe -N -f bc.mak %DEFINES% %USEMINGW_ARG% %*
+
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/stx_goodies_ston.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,211 @@
+"{ Package: 'stx:goodies/ston' }"
+
+"{ NameSpace: Smalltalk }"
+
+LibraryDefinition subclass:#stx_goodies_ston
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'* Projects & Packages *'
+!
+
+
+!stx_goodies_ston class methodsFor:'description'!
+
+excludedFromPreRequisites
+ "obsolete; temporarily, this is still called for, but will eventually vanish.
+
+ List packages which are to be explicitely excluded from the automatic constructed
+ prerequisites lists (both).
+ If empty, everything that is found along the inheritance of any of
+ my classes is considered to be a prerequisite package."
+
+ ^ #(
+ )
+!
+
+mandatoryPreRequisites
+ "list packages which are mandatory as a prerequisite.
+ This are packages containing superclasses of my classes and classes which
+ are extended by myself.
+ They are mandatory, because we need these packages as a prerequisite for loading and compiling.
+ This method is generated automatically,
+ by searching along the inheritance chain of all of my classes.
+ Please take a look at the #referencedPreRequisites method as well."
+
+ ^ #(
+ #'stx:libbasic' "AbstractTime - extended"
+ #'stx:libbasic2' "RunArray - extended"
+ #'stx:libcompat' "FileReference - superclass of STONFileReference"
+ #'stx:libhtml' "URL - extended"
+ #'stx:libview' "Color - extended"
+ )
+!
+
+referencedPreRequisites
+ "list packages which are a prerequisite, because they contain
+ classes which are referenced by my classes.
+ These packages are NOT needed as a prerequisite for compiling or loading,
+ however, a class from it may be referenced during execution and having it
+ unloaded then may lead to a runtime doesNotUnderstand error, unless the caller
+ includes explicit checks for the package being present.
+ This method is generated automatically,
+ by searching all classes (and their packages) which are referenced by my classes.
+ Please also take a look at the #mandatoryPreRequisites method"
+
+ ^ #(
+ )
+!
+
+subProjects
+ "list packages which are known as subprojects.
+ The generated makefile will enter those and make there as well.
+ However: they are not forced to be loaded when a package is loaded;
+ for those, redefine #referencedPrerequisites or #mandatoryPreRequisites."
+
+ ^ #(
+ )
+! !
+
+!stx_goodies_ston class methodsFor:'description - contents'!
+
+classNamesAndAttributes
+ "lists the classes which are to be included in the project.
+ Each entry in the list may be: a single class-name (symbol),
+ or an array-literal consisting of class name and attributes.
+ Attributes are: #autoload or #<os> where os is one of win32, unix,..."
+
+ ^ #(
+ "<className> or (<className> attributes...) in load order"
+ STON
+ STONCStyleCommentsSkipStream
+ STONFileReference
+ STONJSON
+ STONReader
+ STONReaderError
+ STONReference
+ STONStreamWriter
+ STONWriter
+ STONWriterError
+ #'stx_goodies_ston'
+ STONListWriter
+ STONMapWriter
+ STONShortListWriter
+ )
+!
+
+extensionMethodNames
+ "lists the extension methods which are to be included in the project.
+ Entries are 2-element array literals, consisting of class-name and selector.
+ A correponding method with real names must be present in my concrete subclasses
+ if it has extensions."
+
+ ^ #(
+ Association stonOn:
+ Bag stonOn:
+ Boolean stonContainSubObjects
+ Boolean stonOn:
+ ByteArray stonContainSubObjects
+ ByteArray stonOn:
+ Character stonOn:
+ Class stonOn:
+ ClassDescription stonContainSubObjects
+ Collection stonOn:
+ Color stonContainSubObjects
+ Color stonOn:
+ Date stonContainSubObjects
+ Date stonOn:
+ Dictionary stonOn:
+ Dictionary stonPostReferenceResolution
+ Fraction stonOn:
+ Integer stonOn:
+ Interval fromSton:
+ Interval stonOn:
+ Metaclass stonName
+ Metaclass stonOn:
+ Number stonContainSubObjects
+ Number stonOn:
+ Object fromSton:
+ Object isStonReference
+ Object stonContainSubObjects
+ Object stonOn:
+ Object stonPostReferenceResolution
+ Object stonProcessSubObjects:
+ Object stonShouldWriteNilInstVars
+ OrderedDictionary stonOn:
+ Point fromSton:
+ Point stonOn:
+ SequenceableCollection stonOn:
+ Set stonPostReferenceResolution
+ String stonContainSubObjects
+ String stonOn:
+ Symbol stonOn:
+ Time stonContainSubObjects
+ Time stonOn:
+ Timestamp stonContainSubObjects
+ Timestamp stonOn:
+ UndefinedObject stonContainSubObjects
+ UndefinedObject stonOn:
+ 'Bag class' fromSton:
+ 'ByteArray class' fromSton:
+ 'Character class' fromSton:
+ 'Class class' fromSton:
+ 'Collection class' fromSton:
+ 'Color class' fromSton:
+ 'Date class' fromSton:
+ 'Dictionary class' fromSton:
+ 'Interval class' fromSton:
+ 'Metaclass class' fromSton:
+ 'Object class' fromSton:
+ 'Object class' stonAllInstVarNames
+ 'Object class' stonName
+ 'OrderedDictionary class' fromSton:
+ 'RunArray class' fromSton:
+ 'SequenceableCollection class' fromSton:
+ 'Time class' fromSton:
+ 'Timestamp class' fromSton:
+ Filename stonContainSubObjects
+ Filename stonOn:
+ 'URL class' fromSton:
+ 'CharacterArray class' findFirstInString:inSet:startingAt:
+ )
+! !
+
+!stx_goodies_ston class methodsFor:'description - project information'!
+
+companyName
+ "Returns a company string which will appear in <lib>.rc.
+ Under win32, this is placed into the dll's file-info.
+ Other systems may put it elsewhere, or ignore it."
+
+ ^ 'Claus Gittinger & eXept Software AG'
+!
+
+description
+ "Returns a description string which will appear in nt.def / bc.def"
+
+ ^ 'Smalltalk/X Class library'
+!
+
+legalCopyright
+ "Returns a copyright string which will appear in <lib>.rc.
+ Under win32, this is placed into the dll's file-info.
+ Other systems may put it elsewhere, or ignore it."
+
+ ^ 'Copyright Claus Gittinger 2019\nCopyright eXept Software AG 2019'
+!
+
+productName
+ "Returns a product name which will appear in <lib>.rc.
+ Under win32, this is placed into the dll's file-info.
+ This method is usually redefined in a concrete application definition"
+
+ ^ 'Smalltalk/X'
+! !
+
+!stx_goodies_ston class methodsFor:'documentation'!
+
+version_HG
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/stx_goodies_stonWINrc.rc Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,37 @@
+//
+// DO NOT EDIT
+// automagically generated from the projectDefinition: stx_goodies_ston.
+//
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION 8,0,32767,32767
+ PRODUCTVERSION 8,0,99,0
+#if (__BORLANDC__)
+ FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
+ FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
+ FILEOS VOS_NT_WINDOWS32
+ FILETYPE VFT_DLL
+ FILESUBTYPE VS_USER_DEFINED
+#endif
+
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904E4"
+ BEGIN
+ VALUE "CompanyName", "Claus Gittinger & eXept Software AG\0"
+ VALUE "FileDescription", "Smalltalk/X Class library (LIB)\0"
+ VALUE "FileVersion", "8.0.32767.32767\0"
+ VALUE "InternalName", "stx:goodies/ston\0"
+ VALUE "LegalCopyright", "Copyright Claus Gittinger 2019\nCopyright eXept Software AG 2019\0"
+ VALUE "ProductName", "Smalltalk/X\0"
+ VALUE "ProductVersion", "8.0.99.0\0"
+ VALUE "ProductDate", "Tue, 04 Jun 2019 11:32:51 GMT\0"
+ END
+
+ END
+
+ BLOCK "VarFileInfo"
+ BEGIN // Language | Translation
+ VALUE "Translation", 0x409, 0x4E4 // U.S. English, Windows Multilingual
+ END
+END
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/Make.proto Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,148 @@
+# $Header$
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: stx_goodies_ston_tests.
+#
+# Warning: once you modify this file, do not rerun
+# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
+#
+# The Makefile as generated by this Make.proto supports the following targets:
+# make - compile all st-files to a classLib
+# make clean - clean all temp files
+# make clobber - clean all
+#
+# This file contains definitions for Unix based platforms.
+# It shares common definitions with the win32-make in Make.spec.
+
+#
+# position (of this package) in directory hierarchy:
+# (must point to ST/X top directory, for tools and includes)
+TOP=../../..
+INCLUDE_TOP=$(TOP)/..
+
+# subdirectories where targets are to be made:
+SUBDIRS=
+
+
+# subdirectories where Makefiles are to be made:
+# (only define if different from SUBDIRS)
+# ALLSUBDIRS=
+
+REQUIRED_SUPPORT_DIRS=
+
+# if your embedded C code requires any system includes,
+# add the path(es) here:,
+# ********** OPTIONAL: MODIFY the next lines ***
+# LOCALINCLUDES=-Ifoo -Ibar
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/ston -I$(INCLUDE_TOP)/stx/goodies/sunit -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2 -I$(INCLUDE_TOP)/stx/libview
+
+
+# if you need any additional defines for embedded C code,
+# add them here:,
+# ********** OPTIONAL: MODIFY the next lines ***
+# LOCALDEFINES=-Dfoo -Dbar -DDEBUG
+LOCALDEFINES=
+
+LIBNAME=libstx_goodies_ston_tests
+STCLOCALOPT='-package=$(PACKAGE)' -I. $(LOCALINCLUDES) $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -headerDir=. -varPrefix=$(LIBNAME)
+
+
+# ********** OPTIONAL: MODIFY the next line ***
+# additional C-libraries that should be pre-linked with the class-objects
+LD_OBJ_LIBS=
+LOCAL_SHARED_LIBS=
+
+
+# ********** OPTIONAL: MODIFY the next line ***
+# additional C targets or libraries should be added below
+LOCAL_EXTRA_TARGETS=
+
+OBJS= $(COMMON_OBJS) $(UNIX_OBJS)
+
+
+
+all:: preMake classLibRule postMake
+
+pre_objs::
+
+
+
+
+
+
+# Enforce recompilation of package definition class if Mercurial working
+# copy state changes. Together with --guessVersion it ensures that package
+# definition class always contains correct binary revision string.
+ifneq (**NOHG**, $(shell hg root 2> /dev/null || echo -n '**NOHG**'))
+stx_goodies_ston_tests.$(O): $(shell hg root)/.hg/dirstate
+endif
+
+
+
+
+# run default testsuite for this package
+test: $(TOP)/goodies/builder/reports
+ $(MAKE) -C $(TOP)/goodies/builder/reports -f Makefile.init
+ $(TOP)/goodies/builder/reports/report-runner.sh -D . -r Builder::TestReport -p $(PACKAGE)
+
+
+
+# add more install actions here
+install::
+
+# add more install actions for aux-files (resources) here
+installAux::
+
+# add more preMake actions here
+preMake::
+
+# add more postMake actions here
+postMake:: cleanjunk
+
+# build all mandatory prerequisite packages (containing superclasses) for this package
+prereq:
+ cd ../../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ cd ../../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ cd ../../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ cd ../../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ cd ../../sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+
+
+
+# build all packages containing referenced classes for this package
+# they are not needed to compile the package (but later, to load it)
+references:
+
+
+cleanjunk::
+ -rm -f *.s *.s2
+
+clean::
+ -rm -f *.o *.H
+
+clobber:: clean
+ -rm -f *.so *.dll
+
+
+# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)STONCStyleCommentsSkipStreamTests.$(O) STONCStyleCommentsSkipStreamTests.$(C) STONCStyleCommentsSkipStreamTests.$(H): STONCStyleCommentsSkipStreamTests.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONJSONTests.$(O) STONJSONTests.$(C) STONJSONTests.$(H): STONJSONTests.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONReaderTests.$(O) STONReaderTests.$(C) STONReaderTests.$(H): STONReaderTests.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONTestAssociation.$(O) STONTestAssociation.$(C) STONTestAssociation.$(H): STONTestAssociation.st $(INCLUDE_TOP)/stx/libbasic/Association.$(H) $(INCLUDE_TOP)/stx/libbasic/LookupKey.$(H) $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONTestDomainObject.$(O) STONTestDomainObject.$(C) STONTestDomainObject.$(H): STONTestDomainObject.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONTestKnownObject.$(O) STONTestKnownObject.$(C) STONTestKnownObject.$(H): STONTestKnownObject.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONTestMap.$(O) STONTestMap.$(C) STONTestMap.$(H): STONTestMap.st $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Dictionary.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/Set.$(H) $(STCHDR)
+$(OUTDIR)STONTestUser.$(O) STONTestUser.$(C) STONTestUser.$(H): STONTestUser.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONTests.$(O) STONTests.$(C) STONTests.$(H): STONTests.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONWriteReadTests.$(O) STONWriteReadTests.$(C) STONWriteReadTests.$(H): STONWriteReadTests.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONWriterTests.$(O) STONWriterTests.$(C) STONWriterTests.$(H): STONWriterTests.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)stx_goodies_ston_tests.$(O) stx_goodies_ston_tests.$(C) stx_goodies_ston_tests.$(H): stx_goodies_ston_tests.st $(INCLUDE_TOP)/stx/libbasic/LibraryDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProjectDefinition.$(H) $(STCHDR)
+$(OUTDIR)STONLargeWriteReadTests.$(O) STONLargeWriteReadTests.$(C) STONLargeWriteReadTests.$(H): STONLargeWriteReadTests.st $(INCLUDE_TOP)/stx/goodies/ston/tests/STONWriteReadTests.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONTestUser2.$(O) STONTestUser2.$(C) STONTestUser2.$(H): STONTestUser2.st $(INCLUDE_TOP)/stx/goodies/ston/tests/STONTestUser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONTestUser3.$(O) STONTestUser3.$(C) STONTestUser3.$(H): STONTestUser3.st $(INCLUDE_TOP)/stx/goodies/ston/tests/STONTestUser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONWriteAsciiOnlyReadTests.$(O) STONWriteAsciiOnlyReadTests.$(C) STONWriteAsciiOnlyReadTests.$(H): STONWriteAsciiOnlyReadTests.st $(INCLUDE_TOP)/stx/goodies/ston/tests/STONWriteReadTests.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONWritePrettyPrinterReadTests.$(O) STONWritePrettyPrinterReadTests.$(C) STONWritePrettyPrinterReadTests.$(H): STONWritePrettyPrinterReadTests.st $(INCLUDE_TOP)/stx/goodies/ston/tests/STONWriteReadTests.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)STONWriteReadCommentsTests.$(O) STONWriteReadCommentsTests.$(C) STONWriteReadCommentsTests.$(H): STONWriteReadCommentsTests.st $(INCLUDE_TOP)/stx/goodies/ston/tests/STONWriteReadTests.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+
+# ENDMAKEDEPEND --- do not remove this line
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/Make.spec Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,97 @@
+# $Header$
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: stx_goodies_ston_tests.
+#
+# Warning: once you modify this file, do not rerun
+# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
+#
+# This file contains specifications which are common to all platforms.
+#
+
+# Do NOT CHANGE THESE DEFINITIONS
+# (otherwise, ST/X will have a hard time to find out the packages location from its packageID,
+# to find the source code of a class and to find the library for a package)
+MODULE=stx
+MODULE_DIR=goodies/ston/tests
+PACKAGE=$(MODULE):$(MODULE_DIR)
+
+
+# Argument(s) to the stc compiler (stc --usage).
+# -headerDir=. : create header files locally
+# (if removed, they will be created as common
+# -Pxxx : defines the package
+# -Zxxx : a prefix for variables within the classLib
+# -Dxxx : defines passed to CC for inline C-code
+# -Ixxx : include path passed to CC for inline C-code
+# +optspace : optimized for space
+# +optspace2 : optimized more for space
+# +optspace3 : optimized even more for space
+# +optinline : generate inline code for some ST constructs
+# +inlineNew : additionally inline new
+# +inlineMath : additionally inline some floatPnt math stuff
+#
+# ********** OPTIONAL: MODIFY the next line(s) ***
+# STCLOCALOPTIMIZATIONS=+optinline +inlineNew
+# STCLOCALOPTIMIZATIONS=+optspace3
+STCLOCALOPTIMIZATIONS=+optspace3
+
+
+# Argument(s) to the stc compiler (stc --usage).
+# -warn : no warnings
+# -warnNonStandard : no warnings about ST/X extensions
+# -warnEOLComments : no warnings about EOL comment extension
+# -warnPrivacy : no warnings about privateClass extension
+# -warnUnused : no warnings about unused variables
+#
+# ********** OPTIONAL: MODIFY the next line(s) ***
+# STCWARNINGS=-warn
+# STCWARNINGS=-warnNonStandard
+# STCWARNINGS=-warnEOLComments
+STCWARNINGS=-warnNonStandard
+
+COMMON_CLASSES= \
+ STONCStyleCommentsSkipStreamTests \
+ STONJSONTests \
+ STONReaderTests \
+ STONTestAssociation \
+ STONTestDomainObject \
+ STONTestKnownObject \
+ STONTestMap \
+ STONTestUser \
+ STONTests \
+ STONWriteReadTests \
+ STONWriterTests \
+ stx_goodies_ston_tests \
+ STONLargeWriteReadTests \
+ STONTestUser2 \
+ STONTestUser3 \
+ STONWriteAsciiOnlyReadTests \
+ STONWritePrettyPrinterReadTests \
+ STONWriteReadCommentsTests \
+
+
+
+
+COMMON_OBJS= \
+ $(OUTDIR)STONCStyleCommentsSkipStreamTests.$(O) \
+ $(OUTDIR)STONJSONTests.$(O) \
+ $(OUTDIR)STONReaderTests.$(O) \
+ $(OUTDIR)STONTestAssociation.$(O) \
+ $(OUTDIR)STONTestDomainObject.$(O) \
+ $(OUTDIR)STONTestKnownObject.$(O) \
+ $(OUTDIR)STONTestMap.$(O) \
+ $(OUTDIR)STONTestUser.$(O) \
+ $(OUTDIR)STONTests.$(O) \
+ $(OUTDIR)STONWriteReadTests.$(O) \
+ $(OUTDIR)STONWriterTests.$(O) \
+ $(OUTDIR)stx_goodies_ston_tests.$(O) \
+ $(OUTDIR)STONLargeWriteReadTests.$(O) \
+ $(OUTDIR)STONTestUser2.$(O) \
+ $(OUTDIR)STONTestUser3.$(O) \
+ $(OUTDIR)STONWriteAsciiOnlyReadTests.$(O) \
+ $(OUTDIR)STONWritePrettyPrinterReadTests.$(O) \
+ $(OUTDIR)STONWriteReadCommentsTests.$(O) \
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/Makefile.init Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,27 @@
+#
+# DO NOT EDIT
+#
+# make uses this file (Makefile) only, if there is no
+# file named "makefile" (lower-case m) in the same directory.
+# My only task is to generate the real makefile and call make again.
+# Thereafter, I am no longer used and needed.
+#
+# MACOSX caveat:
+# as filenames are not case sensitive (in a default setup),
+# we cannot use the above trick. Therefore, this file is now named
+# "Makefile.init", and you have to execute "make -f Makefile.init" to
+# get the initial makefile. This is now also done by the toplevel CONFIG
+# script.
+
+.PHONY: run
+
+run: makefile
+ $(MAKE) -f makefile
+
+#only needed for the definition of $(TOP)
+include Make.proto
+
+makefile: mf
+
+mf:
+ $(TOP)/rules/stmkmf
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONCStyleCommentsSkipStreamTests.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,91 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#STONCStyleCommentsSkipStreamTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Reader'
+!
+
+!STONCStyleCommentsSkipStreamTests methodsFor:'testing'!
+
+testBlockReading
+ | input buffer |
+ input := STONCStyleCommentsSkipStream on: 'abc/*comment*/def' readStream.
+ buffer := String new: 6.
+ self assert: (input readInto: buffer startingAt: 1 count: 4) equals: 4.
+ self assert: (buffer copyFrom: 1 to: 4) equals: 'abcd'.
+ self assert: (input readInto: buffer startingAt: 5 count: 4) equals: 2.
+ self assert: buffer equals: 'abcdef'.
+ input := STONCStyleCommentsSkipStream on: 'abc//comment\def' withCRs readStream.
+ buffer := String new: 6.
+ self assert: (input readInto: buffer startingAt: 1 count: 6) equals: 6.
+ self assert: buffer equals: 'abcdef'.
+ self assert: input atEnd
+!
+
+testCommentInString
+ self
+ assert: (STONCStyleCommentsSkipStream on: '''/*comment*/''' readStream) upToEnd
+ equals: '''/*comment*/'''.
+ self
+ assert: (STONCStyleCommentsSkipStream on: '{''foo'':''/*comment*/bar''}' readStream) upToEnd
+ equals: '{''foo'':''/*comment*/bar''}'.
+ self
+ assert: (STONCStyleCommentsSkipStream on: '{''foo'':''//comment\''bar''}' readStream) upToEnd
+ equals: '{''foo'':''//comment\''bar''}'.
+ self
+ assert: (STONCStyleCommentsSkipStream on: '{"foo":"/*comment*/bar"}' readStream) upToEnd
+ equals: '{"foo":"/*comment*/bar"}'.
+ self
+ assert: (STONCStyleCommentsSkipStream on: '{"foo":"//comment\"bar"}' readStream) upToEnd
+ equals: '{"foo":"//comment\"bar"}'
+!
+
+testMultiLineComment
+ self
+ assert: (STONCStyleCommentsSkipStream on: 'foo\//comment\bar' withCRs readStream) upToEnd
+ equals: 'foo\bar' withCRs.
+ self
+ assert: (STONCStyleCommentsSkipStream on: 'foo\//comment\bar' withCRs readStream) nextLine
+ equals: 'foo'.
+ self
+ assert: ((STONCStyleCommentsSkipStream on: 'foo\//comment\bar' withCRs readStream) nextLine; nextLine)
+ equals: 'bar'.
+ self assert: (STONCStyleCommentsSkipStream on: '//comment' readStream) atEnd.
+!
+
+testNonComment
+ self assert: (STONCStyleCommentsSkipStream on: 'foo' readStream) upToEnd equals: 'foo'.
+ self assert: (STONCStyleCommentsSkipStream on: 'foo' readStream) nextLine equals: 'foo'.
+ self deny: (STONCStyleCommentsSkipStream on: 'foo' readStream) atEnd.
+ self assert: (STONCStyleCommentsSkipStream on: '' readStream) atEnd.
+!
+
+testSTON
+ "Comments are processed first and totally removed.
+ They are not even whitespace (not that whitespace is relevant in STON)."
+
+ self
+ assert: (STON fromStream: (STONCStyleCommentsSkipStream on: '123/*comment*/456' readStream))
+ equals: 123456.
+ self
+ assert: (STON fromStream: (STONCStyleCommentsSkipStream on: '/*comment*/''abcd''' readStream))
+ equals: 'abcd'.
+ self
+ assert: (STON fromStream: (STONCStyleCommentsSkipStream on: '123//456' readStream))
+ equals: 123.
+ self
+ should: [ STON fromStream: (STONCStyleCommentsSkipStream on: '//456' readStream) ]
+ raise: STONReaderError
+!
+
+testSingleLineComment
+ self assert: (STONCStyleCommentsSkipStream on: 'foo/*comment*/bar' readStream) upToEnd equals: 'foobar'.
+ self assert: (STONCStyleCommentsSkipStream on: 'foo/*comment*/bar' readStream) nextLine equals: 'foobar'.
+ self deny: (STONCStyleCommentsSkipStream on: 'foo/*comment*/bar' readStream) atEnd.
+ self assert: (STONCStyleCommentsSkipStream on: '/*comment*/' readStream) atEnd.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONJSONTests.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,139 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#STONJSONTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Facade'
+!
+
+!STONJSONTests methodsFor:'tests'!
+
+testBooleans
+ self assert: (STONJSON toString: true) equals: 'true'.
+ self assert: (STONJSON toString: false) equals: 'false'.
+ self assert: (STONJSON fromString: 'true') equals: true.
+ self assert: (STONJSON fromString: 'false') equals: false.
+!
+
+testCircular
+ "Circular datastructures cannot be encoded using JSON"
+ self
+ should: [ | foo |
+ foo := { 'foo'->'dummy' } asDictionary.
+ foo at: 'bar' put: foo.
+ STONJSON toString: foo ]
+ raise: STONWriterError
+!
+
+testFloats
+ self assert: (STONJSON toString: 1.0) equals: '1.0'.
+ self assert: (STONJSON toString: 0.0) equals: '0.0'.
+ self assert: (STONJSON toString: -1.0) equals: '-1.0'.
+ self assert: (STONJSON toString: -1.23456E-6) equals: '-1.23456E-06'.
+ self assert: ((STONJSON fromString: '1.0') closeTo: 1.0).
+ self assert: ((STONJSON fromString: '0.0') closeTo: 0.0).
+ self assert: ((STONJSON fromString: '-1.0') closeTo: -1.0).
+ self assert: ((STONJSON fromString: '-1.23456E-6') closeTo: -1.23456E-06).
+
+ "Modified: / 20-05-2020 / 13:08:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testIntegers
+ self assert: (STONJSON toString: 1) equals: '1'.
+ self assert: (STONJSON toString: 0) equals: '0'.
+ self assert: (STONJSON toString: -1) equals: '-1'.
+ self assert: (STONJSON toString: 1234567890) equals: '1234567890'.
+ self assert: (STONJSON fromString: '1') equals: 1.
+ self assert: (STONJSON fromString: '0') equals: 0.
+ self assert: (STONJSON fromString: '-1') equals: -1.
+ self assert: (STONJSON fromString: '1234567890') equals: 1234567890.
+!
+
+testLists
+ self assert: (STONJSON toString: #(1 2 3)) equals: '[1,2,3]'.
+ self assert: (STONJSON toString: #(1 -2 true 3 nil)) equals: '[1,-2,true,3,null]'.
+ self assert: (STONJSON toString: #(1 (2) 3)) equals: '[1,[2],3]'.
+ self assert: (STONJSON toString: #()) equals: '[]'.
+ self assert: (STONJSON fromString: '[]') equals: #().
+ self assert: (STONJSON fromString: '[1,2,3]') equals: #(1 2 3).
+ self assert: (STONJSON fromString: '[1,-2,true,3,null]') equals: #(1 -2 true 3 nil).
+ self assert: (STONJSON fromString: '[1,[2],3]') equals: #(1 (2) 3).
+!
+
+testMaps
+ self assert: (STONJSON toString: (Dictionary withAssociations: { 'temperature'->37 })) equals: '{"temperature":37}'.
+ self assert: (STONJSON toString: Dictionary new) equals: '{}'.
+ self assert: (STONJSON fromString: '{"temperature":37}') equals: (Dictionary withAssociations: { 'temperature'->37 }).
+ self assert: (STONJSON fromString: '{}') equals: Dictionary new.
+
+ "Modified: / 20-05-2020 / 11:24:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testNull
+ self assert: (STONJSON toString: nil) equals: 'null'.
+ self assert: (STONJSON fromString: 'null') equals: nil.
+!
+
+testOrderedDictionary
+ | odictClass odict json dict |
+
+ odictClass := Smalltalk at: #OrderedDictionary ifAbsent: [ ^ self skip ].
+
+ odict := odictClass newFrom: {
+ 'a' -> 42 . 'b' -> 1. 'aa' -> 4. 'c' -> 23
+ }.
+
+ "assert that the order is not equal in the dictionary hash table".
+ self
+ assertCollection: odict asArray
+ hasSameElements: odict dictionary asArray;
+ deny: odict asArray = odict dictionary asArray.
+
+ "ordered presevered when encoding:"
+ json := STONJSON toString: odict.
+ self assert: json equals: '{"a":42,"b":1,"aa":4,"c":23}'.
+
+ "lost when decoding"
+ dict := STONJSON fromString: json.
+
+ self
+ assertCollection: dict asArray hasSameElements: odict asArray;
+ assert: dict equals: odict dictionary;
+ deny: dict asArray = odict asArray
+!
+
+testShared
+ "Structure sharing cannot be encoded using JSON"
+ self
+ should: [ | foo |
+ foo := { 'foo'->'dummy' } asDictionary.
+ STONJSON toString: { foo. foo } ]
+ raise: STONWriterError
+!
+
+testStrings
+ self assert: (STONJSON toString: 'string') equals: '"string"'.
+ self assert: (STONJSON toString: '') equals: '""'.
+ self assert: (STONJSON toString: 'élèves français') equals: '"élèves français"'.
+ self assert: (STONJSON toString: String crlf) equals: '"\r\n"'.
+ self assert: (STONJSON fromString: '"string"') equals: 'string'.
+ self assert: (STONJSON fromString: '""') equals: ''.
+ self assert: (STONJSON fromString: '"élèves français"') equals: 'élèves français'.
+ self
+ assert: (STONJSON fromString: '"\u212B \"Angstrom Symbol\""')
+ equals: 8491 asCharacter asString, ' "Angstrom Symbol"'.
+!
+
+testUnknown
+ "Only Array for lists and Dictionary for maps are allowed for JSON encoding,
+ any other Smalltalk object cannot be encoded (following the specs).
+ Even considering all collections to be lists won't work because the type
+ is then lost when decoding"
+
+ self should: [ STONJSON toString: 1@2 ] raise: STONWriterError.
+ self should: [ STONJSON toString: #(1 2 3) asOrderedCollection ] raise: STONWriterError.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONLargeWriteReadTests.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,37 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+STONWriteReadTests subclass:#STONLargeWriteReadTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Write-Read'
+!
+
+!STONLargeWriteReadTests methodsFor:'private'!
+
+materialize: string
+ ^ STON reader
+ on: string readStream;
+ optimizeForLargeStructures;
+ next
+!
+
+serialize: anObject
+ ^ String streamContents: [ :stream |
+ STON writer
+ on: stream;
+ optimizeForLargeStructures;
+ nextPut: anObject ]
+!
+
+serializeJson: anObject
+ ^ String streamContents: [ :stream |
+ STON jsonWriter
+ on: stream;
+ prettyPrint: true;
+ optimizeForLargeStructures;
+ nextPut: anObject ]
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONReaderTests.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,498 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#STONReaderTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Reader'
+!
+
+
+!STONReaderTests methodsFor:'private'!
+
+materialize: string
+ ^ STON reader
+ on: string readStream;
+ next
+! !
+
+!STONReaderTests methodsFor:'tests'!
+
+testAssociation
+ self assert: (self materialize: '''foo'':1') = ('foo' -> 1).
+ self assert: (self materialize: '#bar:2') = (#bar -> 2).
+ self assert: (self materialize: '''foo bar'':#ok') = ('foo bar' -> #ok).
+ self assert: (self materialize: '123:456') = (123 -> 456).
+
+ self assert: (self materialize: '''foo'' : 1') = ('foo' -> 1).
+ self assert: (self materialize: '#bar : 2') = (#bar -> 2).
+ self assert: (self materialize: '''foo bar'' : #ok') = ('foo bar' -> #ok).
+ self assert: (self materialize: '123 : -456') = (123 -> -456).
+
+ self assert: (self materialize: '#foo : 1 : 2') = (#foo -> (1 -> 2))
+!
+
+testBag
+ self
+ assert: (self materialize: 'Bag{#a:2,#b:3}')
+ equals: (Bag withAll: #(a a b b b)).
+ self
+ assert: (self materialize: 'Bag{}')
+ equals: Bag new.
+!
+
+testBoolean
+ self assert: (self materialize: 'true') equals: true.
+ self assert: (self materialize: 'false') equals: false
+!
+
+testByteArray
+ self assert: (self materialize: 'ByteArray[''010203'']') = #(1 2 3) asByteArray
+!
+
+testCharacter
+ self assert: (self materialize: 'Character[''A'']') == $A.
+!
+
+testClass
+ self assert: (self materialize: 'Class[#Point]') equals: Point
+!
+
+testClassWithUnderscore
+
+ | cls data reader |
+
+ cls := Class new.
+ cls setName: #A_B_C123AnonClass.
+
+ data := STON toString: cls new.
+ reader := STONReader on: data readStream.
+
+ (reader instVarNamed: #classes)
+ at: cls name
+ put: cls.
+
+ self assert: reader next class equals: cls
+
+ "Modified: / 20-05-2020 / 12:24:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testColor
+ self
+ assert: (self materialize: 'Color[#red]')
+ equals: Color red.
+ self
+ assert: (self materialize: 'Color{#red:1.0,#green:0.0,#blue:0.0,#alpha:0.4}')
+ equals: (Color red copy alpha: 0.4).
+ self
+ assert: (self materialize: 'Color{#red:1.0,#green:0.79339284351873047,#blue:0.79339284351873047,#alpha:1.0}')
+ equals: Color red lighter lighter.
+
+ "Modified: / 20-05-2020 / 12:23:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testConvertingNewLines
+ | input result output |
+ input := '''line ending with CR', String return,
+ 'line ending with LF', String lf,
+ 'line ending with CRLF', String crlf, ''''.
+ output := 'line ending with CR', String crlf,
+ 'line ending with LF', String crlf,
+ 'line ending with CRLF', String crlf.
+ result := (STON reader on: input readStream) newLine: String crlf; convertNewLines: true; next.
+ self assert: result equals: output.
+ output := 'line ending with CR', String return,
+ 'line ending with LF', String return,
+ 'line ending with CRLF', String return.
+ result := (STON reader on: input readStream) newLine: String return; convertNewLines: true; next.
+ self assert: result equals: output
+
+ "Modified: / 04-06-2019 / 10:51:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testDate
+ | date |
+ date := (Date year: 2012 month: 1 day: 1) translateToUTC.
+ self assert: (self materialize: 'Date[''2012-01-01Z'']') equals: date.
+ self assert: (self materialize: 'Date[''2012-01-01+00:00'']') equals: date.
+ date := (Date year: 2012 month: 1 day: 1) translateTo: 1 hour.
+ self assert: (self materialize: 'Date[''2012-01-01+01:00'']') equals: date.
+ "a missing timezone offset results in the local timezone offset being used,
+ this is never written by STON, but matches the first implementation for backwards compatibility"
+ date := Date year: 2012 month: 1 day: 1.
+ self assert: (self materialize: 'Date[''2012-01-01'']') equals: date.
+!
+
+testDateAndTime
+ | dateAndTime |
+ dateAndTime := DateAndTime year: 2012 month: 1 day: 1 hour: 6 minute: 30 second: 15 offset: 1 hour.
+ self assert: (self materialize: 'DateAndTime[''2012-01-01T06:30:15+01:00'']') = dateAndTime
+!
+
+testDeepStructure
+ | holder deepest structure writer ston reader result |
+
+ self skip: 'Uses too much stack for stock St/X settings'.
+
+ "Create a deep nested structure so that the deepest element is a reference back to a top level holder."
+ holder := Array with: 42.
+ deepest := Array with: holder.
+ structure := deepest.
+ 1 * 1024 timesRepeat: [ structure := Array with: structure ].
+ structure := Array with: holder with: structure.
+ writer := STON writer optimizeForLargeStructures.
+ ston := String streamContents: [ :out | (writer on: out) nextPut: structure ].
+ "After reading, the second pass will have to go down the structure to resolve the reference."
+ reader := STON reader optimizeForLargeStructures.
+ result := (reader on: ston readStream) next.
+ self assert: result equals: structure
+
+ "Modified: / 20-05-2020 / 11:30:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testDictionary
+ | collection |
+ collection := STON mapClass new at: 1 put: 1; at: 2 put: 2; yourself.
+ self assert: (self materialize: '{1:1,2:2}') = collection.
+ self assert: (self materialize: '{}') = STON mapClass new.
+!
+
+testDictionaryWithComplexKeys
+ | collection reader |
+ collection := STON mapClass new at: true put: 1; at: #(foo) put: 2; yourself.
+ "allowing complex map keys used to be optional, now it is always the default"
+ reader := STONReader on: '{true:1,[#foo]:2}' readStream.
+ self assert: reader next = collection
+!
+
+testDictionaryWithIndirectReferenceKeys
+ | keysCollection dictionary ston object |
+ keysCollection := OrderedCollection streamContents: [ :out |
+ 10 timesRepeat: [ out nextPut: UUID new ] ].
+ dictionary := Dictionary new.
+ keysCollection doWithIndex: [ :each :index |
+ dictionary at: (Array with: each) put: index ].
+ object := Array with: keysCollection with: dictionary.
+ ston := STON toStringPretty: object.
+ object := (STON reader on: ston readStream) next.
+ object first doWithIndex: [ :each :index |
+ self assert: (object second at: (Array with: each)) equals: index ].
+ self assert: object second isHealthy
+!
+
+testDictionaryWithReferenceKeys
+ | keysCollection dictionary ston object |
+ keysCollection := OrderedCollection streamContents: [ :out |
+ 10 timesRepeat: [ out nextPut: UUID new ] ].
+ dictionary := Dictionary new.
+ keysCollection doWithIndex: [ :each :index |
+ dictionary at: each put: index ].
+ object := Array with: keysCollection with: dictionary.
+ ston := STON toStringPretty: object.
+ object := (STON reader on: ston readStream) next.
+ object first doWithIndex: [ :each :index |
+ self assert: (object second at: each) equals: index ].
+ self assert: object second isHealthy
+!
+
+testDiskFile
+ self assert: (self materialize: 'FILE[''foo.txt'']') equals: 'foo.txt' asFilename.
+ self assert: (self materialize: 'FILE[''/tmp/foo.txt'']') equals: '/tmp/foo.txt' asFilename.
+ self assert: (self materialize: 'FILE[''tmp/foo.txt'']') equals: 'tmp/foo.txt' asFilename.
+ self assert: (self materialize: 'FILE[''/tmp'']') equals: '/tmp' asFilename.
+
+ "Modified: / 20-05-2020 / 12:42:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testError
+ #( 'foo' '{foo:}' '{foo,}' '[1,]' '+1' ']' '#' '' ' ' ' ' 'nul' 'tru' 'fals' ) do: [ :each |
+ self
+ should: [ self materialize: each ]
+ raise: STONReaderError ]
+!
+
+testFloat
+ self assert: ((self materialize: '1.5') closeTo: 1.5).
+ self assert: ((self materialize: '-1.5') closeTo: -1.5).
+ self assert: (self materialize: '0.0') isZero.
+ self assert: (Float pi closeTo: (self materialize: '3.14149')).
+ self assert: (1/3 closeTo: (self materialize: '0.333333')).
+ self assert: ((self materialize: '1.0e100') closeTo: (10 raisedTo: 100)).
+ self assert: ((self materialize: '1.0e-100') closeTo: (10 raisedTo: -100)).
+ self assert: ((self materialize: '-1.0e-100') closeTo: (10 raisedTo: -100) negated)
+!
+
+testFraction
+ self assert: (self materialize: '1/3') equals: 1/3.
+ self assert: (self materialize: '-1/3') equals: -1/3.
+ self assert: (self materialize: '100/11') equals: 100/11.
+!
+
+testIdentityDictionary
+ | collection |
+ collection := IdentityDictionary new at: 1 put: 1; at: 2 put: 2; yourself.
+ self assert: (self materialize: 'IdentityDictionary{1:1,2:2}') = collection.
+ self assert: (self materialize: 'IdentityDictionary{}') = IdentityDictionary new.
+!
+
+testIllegalCharacterEscapes
+ self should: [ STON fromString: '''\a''' ] raise: STONReaderError.
+ self should: [ STON fromString: '''\u''' ] raise: STONReaderError.
+ self should: [ STON fromString: '''\u00''' ] raise: STONReaderError.
+ self should: [ STON fromString: '''\u000''' ] raise: STONReaderError.
+ self should: [ STON fromString: '''\*''' ] raise: STONReaderError
+!
+
+testInteger
+ self assert: (self materialize: '1') = 1.
+ self assert: (self materialize: '-1') = -1.
+ self assert: (self materialize: '0') = 0.
+ self assert: (self materialize: '1234567890') = 1234567890.
+ self assert: (self materialize: '-1234567890') = -1234567890
+!
+
+testList
+ self assert: STON listClass = Array.
+ self assert: (self materialize: '[1,2,3]') = (STON listClass with: 1 with: 2 with: 3).
+ self assert: (self materialize: '[]') = STON listClass new
+!
+
+testMap
+ self assert: (self materialize: '{#foo:1}') = (STON mapClass new at: #foo put: 1; yourself).
+ self assert: (self materialize: '{}') = STON mapClass new
+!
+
+testMetaclass
+ self assert: (self materialize: 'Metaclass[#Point]') equals: Point class
+!
+
+testMimeType
+ self skip: 'No ZnMimeType in St/X'.
+
+"/ self
+"/ assert: (self materialize: 'MimeType[''application/json'']')
+"/ equals: ZnMimeType applicationJson.
+"/ self
+"/ assert: (self materialize: 'MimeType[''text/plain;charset=utf-8'']')
+"/ equals: ZnMimeType textPlain.
+
+ "Modified: / 20-05-2020 / 12:06:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testMultiple
+ | reader |
+ reader := STON reader
+ on: '123 -123 nil #foo true [ 0 ] false { #one : 1 }' readStream.
+ self deny: reader atEnd.
+ self assert: reader next equals: 123.
+ self assert: reader next equals: -123.
+ self assert: reader next equals: nil.
+ self assert: reader next equals: #foo.
+ self assert: reader next equals: true.
+ self assert: reader next equals: { 0 }.
+ self assert: reader next equals: false.
+ self assert: reader next equals: (Dictionary with: #one -> 1).
+ self assert: reader atEnd.
+!
+
+testNewSymbol
+ | n notASymbol shouldBeSymbol |
+
+ "Find a name that has not yet been interned"
+ n := 0.
+ [ Symbol hasInterned: (notASymbol := 'notASymbol', n printString) ifTrue: [ :symbol | symbol ] ]
+ whileTrue: [ n := n + 1 ].
+ "Parsing the new, not yet interned name should create a new Symbol"
+ shouldBeSymbol := self materialize: '#', notASymbol.
+ self assert: (shouldBeSymbol isSymbol and: [ notASymbol = shouldBeSymbol asString ])
+!
+
+testNil
+ self assert: (self materialize: 'nil') isNil
+!
+
+testNonBMPCharacterDecoding
+ "Characters not in the Basic Multilingual Plane are encoded as a UTF-16 surrogate pair"
+
+ | string object |
+ string := 16r1D11E asCharacter asString. "MUSICAL SYMBOL G CLEF"
+ object := (STON fromString: '''\uD834\uDD1E''').
+ self assert: object equals: string
+
+ "Modified: / 20-05-2020 / 12:05:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testNull
+ self assert: (self materialize: 'null') isNil
+!
+
+testObject
+ self assert: (self materialize: 'Point[1,2]') = (1@2).
+ self assert: (self materialize: 'Point[1.5,-0.5]') = (1.5 @ -0.5).
+!
+
+testOrderedCollection
+ | collection |
+ collection := OrderedCollection with: 1 with: 2 with: 3.
+ self assert: (self materialize: 'OrderedCollection[1,2,3]') = collection.
+ self assert: (self materialize: 'OrderedCollection[]') = OrderedCollection new.
+!
+
+testPoint
+ self assert: (self materialize: 'Point[1,2]') = (1@2)
+!
+
+testReferenceCycle
+ | array |
+ array := (self materialize: '[1,@1]').
+ self assert: array class = STON listClass.
+ self assert: array size = 2.
+ self assert: array first = 1.
+ self assert: array second == array
+!
+
+testReferenceSharing
+ | one array |
+ one := { #one }.
+ array := (self materialize: '[[#one],@2,@2]').
+ self assert: array = (STON listClass with: one with: one with: one).
+ self assert: array first == array second.
+ self assert: array first == array third
+!
+
+testScaledDecimal
+ self skip.
+
+ self assert: (self materialize: '1/3s2') equals: 1/3s2.
+ self assert: (self materialize: '-1/3s2') equals: -1/3s2.
+ self assert: (self materialize: '1/3s10') equals: 1/3s10.
+ self assert: (self materialize: '-1/3s10') equals: -1/3s10.
+
+ "Modified: / 20-05-2020 / 12:03:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testSetWithIndirectReferenceElements
+ | elementsCollection set ston object |
+ elementsCollection := OrderedCollection streamContents: [ :out |
+ 10 timesRepeat: [ out nextPut: UUID new ] ].
+ set := Set withAll: (elementsCollection collect: [ :each | Array with: each ]).
+ object := Array with: elementsCollection with: set.
+ ston := STON toStringPretty: object.
+ object := STON fromString: ston readStream.
+ object first do: [ :each |
+ self assert: (object second includes: (Array with: each)) ].
+ self assert: object second isHealthy
+!
+
+testSetWithReferenceElements
+ | elementsCollection set ston object |
+ elementsCollection := OrderedCollection streamContents: [ :out |
+ 10 timesRepeat: [ out nextPut: UUID new ] ].
+ set := Set withAll: elementsCollection.
+ object := Array with: elementsCollection with: set.
+ ston := STON toStringPretty: object.
+ object := STON fromString: ston readStream.
+ object first do: [ :each |
+ self assert: (object second includes: each) ].
+ self assert: object second isHealthy
+!
+
+testStreaming
+ | reader |
+ reader := STON reader
+ on: '1 2 3 4 5 6 7 8 9 10' readStream.
+ self
+ assert: (Array streamContents: [ :stream |
+ [ reader atEnd] whileFalse: [
+ stream nextPut: reader next ] ]) sum
+ equals: #(1 2 3 4 5 6 7 8 9 10) sum
+!
+
+testString
+ | string |
+ self assert: (self materialize: '''foo''') = 'foo'.
+ self assert: (self materialize: '''FOO''') = 'FOO'.
+ self assert: (self materialize: '''\u00E9l\u00E8ve en Fran\u00E7ais''') = #[195 169 108 195 168 118 101 32 101 110 32 70 114 97 110 195 167 97 105 115] utf8Decoded .
+ string := String withAll: {
+ $". $'. $\. $/. Character tab. Character cr. Character lf. Character newPage. Character backspace }.
+ self assert: (self materialize: '''\"\''\\\/\t\r\n\f\b''') = string.
+
+ "Modified: / 20-05-2020 / 12:03:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testSymbol
+ self assert: (self materialize: '#''foo''') = #foo.
+ self assert: (self materialize: '#foo') = #foo
+!
+
+testTime
+ | time |
+ time := Time hour: 6 minute: 30 second: 15.
+ self assert: (self materialize: 'Time[''06:30:15'']') equals: time.
+ time := Time hours: 6 minutes: 30 seconds: 15 milliseconds: 123.
+ self assert: (self materialize: 'Time[''06:30:15.123'']') equals: time.
+
+ "Modified: / 20-05-2020 / 12:01:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testURL
+ self
+ assert: (self materialize: 'URL[''https://pharo.org/files/pharo.png'']')
+ equals: 'https://pharo.org/files/pharo.png' asUrl.
+ self
+ assert: (self materialize: 'URL[''mailto:sven@stfx.eu'']')
+ equals: 'mailto:sven@stfx.eu' asUrl.
+ self
+ assert: (self materialize: 'URL[''file:///var/log/system.log'']')
+ equals: 'file:///var/log/system.log' asUrl.
+ self
+ assert: (self materialize: 'URL[''scheme://user:password@host:123/var/log/system.log?foo=1&bar#frag'']')
+ equals: 'scheme://user:password@host:123/var/log/system.log?foo=1&bar#frag' asUrl.
+!
+
+testUnknownClasses
+ | input object |
+ input := 'FooBar { #foo : 1, #bar : true }'.
+ self should: [ self materialize: input ] raise: STONReaderError.
+ object := STON reader
+ acceptUnknownClasses: true;
+ on: input readStream;
+ next.
+ self assert: object class equals: STON mapClass.
+ self assert: (object at: #foo) equals: 1.
+ self assert: (object at: #bar).
+ self assert: (object at: STON classNameKey) equals: #FooBar
+!
+
+testUser
+ | user |
+ (user := STONTestUser new)
+ username: 'john@foo.com';
+ password: 'secret1'.
+ self assert: (self materialize: 'STONTestUser{#username:''john@foo.com'',#password:''secret1'',#enabled:true}') = user
+!
+
+testUser2
+ | user |
+ (user := STONTestUser2 new)
+ username: 'john@foo.com';
+ password: 'secret1'.
+ self assert: (self materialize: 'STONTestUser2{#username:''john@foo.com'',#password:''secret1'',#enabled:true}') = user
+!
+
+testWhitespace
+ | whitespace |
+ whitespace := { Character space. Character tab. Character cr. Character lf }.
+ self assert: (self materialize: whitespace, '123') = 123
+
+! !
+
+!STONReaderTests class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONTestAssociation.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,31 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+Association subclass:#STONTestAssociation
+ instanceVariableNames:'timestamp'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Support'
+!
+
+!STONTestAssociation methodsFor:'accessing'!
+
+key: aKey value: anObject
+ super key: aKey value: anObject.
+ timestamp := self now
+!
+
+now
+ ^ DateAndTime now
+!
+
+timestamp
+ ^ timestamp
+!
+
+value: anObject
+ super value: anObject.
+ timestamp := self now
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONTestDomainObject.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,155 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#STONTestDomainObject
+ instanceVariableNames:'created modified integer float description color tags bytes
+ boolean'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Support'
+!
+
+!STONTestDomainObject class methodsFor:'instance creation'!
+
+dummy
+ ^ self new
+ integer: 999999 atRandom;
+ float: 999 atRandom / Float pi;
+ boolean: #(true false) atRandom;
+ bytes: (ByteArray streamContents: [ :out | 32 timesRepeat: [ out nextPut: 255 atRandom ] ]);
+ description: (String streamContents: [ :out | 16 atRandom timesRepeat: [ out nextPutAll: 'Blah' ] ]);
+ color: #(#red #green #blue) atRandom;
+ tags: (Array
+ with: #(#one #two #three) atRandom
+ with: #(#alpha #beta #gamma) atRandom
+ with: #(#low #medium #high) atRandom);
+ yourself
+! !
+
+!STONTestDomainObject class methodsFor:'ston-core'!
+
+stonName
+ ^ #TestDomainObject
+! !
+
+!STONTestDomainObject methodsFor:'accessing'!
+
+boolean
+ ^ boolean
+!
+
+boolean: anObject
+ boolean := anObject
+!
+
+bytes
+ ^ bytes
+!
+
+bytes: anObject
+ bytes := anObject
+!
+
+color
+ ^ color
+!
+
+color: anObject
+ color := anObject
+!
+
+created
+ ^ created
+!
+
+created: anObject
+ created := anObject
+!
+
+description
+ ^ description
+!
+
+description: anObject
+ description := anObject
+!
+
+float
+ ^ float
+!
+
+float: anObject
+ float := anObject
+!
+
+integer
+ ^ integer
+!
+
+integer: anObject
+ integer := anObject
+!
+
+modified
+ ^ modified
+!
+
+modified: anObject
+ modified := anObject
+!
+
+tags
+ ^ tags
+!
+
+tags: anObject
+ tags := anObject
+! !
+
+!STONTestDomainObject methodsFor:'comparing'!
+
+= anObject
+ "Answer whether the receiver and anObject represent the same object."
+
+ self == anObject
+ ifTrue: [ ^ true ].
+ self class = anObject class
+ ifFalse: [ ^ false ].
+ ^ color = anObject color
+ and: [
+ modified = anObject modified
+ and: [
+ created = anObject created
+ and: [
+ description = anObject description
+ and: [
+ boolean = anObject boolean
+ and: [
+ (float closeTo: anObject float) "Use #closeTo: instead of #= to increase portability"
+ and: [
+ bytes = anObject bytes
+ and: [
+ integer = anObject integer
+ and: [ tags = anObject tags ] ] ] ] ] ] ] ]
+!
+
+hash
+ "Answer an integer value that is related to the identity of the receiver."
+
+ ^ color hash
+ bitXor:
+ (modified hash
+ bitXor:
+ (created hash
+ bitXor:
+ (description hash
+ bitXor: (boolean hash bitXor: (float hash bitXor: (bytes hash bitXor: (integer hash bitXor: tags hash)))))))
+! !
+
+!STONTestDomainObject methodsFor:'initialize-release'!
+
+initialize
+ created := modified := DateAndTime now.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONTestKnownObject.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,104 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#STONTestKnownObject
+ instanceVariableNames:'id description'
+ classVariableNames:'KnownObjects'
+ poolDictionaries:''
+ category:'STON-Tests-Support'
+!
+
+
+!STONTestKnownObject class methodsFor:'instance creation'!
+
+fromId: idString
+ "Given id, return a matching instance of me, either by returning an existing known instance or by creating a new one (that is automtically added to the known instances)"
+
+ | uuid |
+ uuid := UUID fromString: idString.
+ ^ self knownObjects
+ detect: [ :each | each id = uuid ]
+ ifNone: [ self new id: uuid ]
+! !
+
+!STONTestKnownObject class methodsFor:'acccessing'!
+
+addKnownObject: object
+ ^ self knownObjects addIfNotPresent: object
+!
+
+knownObjects
+ ^ KnownObjects ifNil: [ KnownObjects := OrderedCollection new ]
+!
+
+resetKnownObjects
+ KnownObjects ifNotNil: [ :collection | collection removeAll ]
+! !
+
+!STONTestKnownObject class methodsFor:'ston-core'!
+
+fromSton: stonReader
+ ^ self fromId: stonReader parseListSingleton
+! !
+
+!STONTestKnownObject methodsFor:'accessing'!
+
+description
+ ^ description
+!
+
+id
+ ^ id
+! !
+
+!STONTestKnownObject methodsFor:'comparing'!
+
+= object
+ self class == object class ifFalse: [ ^ false ].
+ ^ self id = object id
+!
+
+hash
+ ^ self id hash
+! !
+
+!STONTestKnownObject methodsFor:'initalize'!
+
+description: string
+ description := string
+!
+
+id: uuid
+ id := uuid.
+ self description: 'I am a complex object known under the ID ', id asString, ' - I was created @ ', DateAndTime now asString
+!
+
+initialize
+ super initialize.
+ self id: UUID new.
+ self class addKnownObject: self
+! !
+
+!STONTestKnownObject methodsFor:'printing'!
+
+printOn: stream
+ super printOn: stream.
+ stream nextPut: $(; print: id; nextPut: $)
+! !
+
+!STONTestKnownObject methodsFor:'ston-core'!
+
+stonOn: stonWriter
+ "We only write out our id"
+
+ stonWriter writeObject: self listSingleton: self id asString
+! !
+
+!STONTestKnownObject class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONTestMap.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,77 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+Dictionary subclass:#STONTestMap
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Support'
+!
+
+!STONTestMap class methodsFor:'instance creation'!
+
+classTree
+ ^ self classTree: Object
+!
+
+classTree: topClass
+ | map |
+ map := IdentityDictionary new.
+ topClass withAllSubclasses do: [ :eachClass | | info |
+ (info := self new)
+ at: #name put: eachClass name asString;
+ at: #comment put: eachClass comment;
+ at: #isMeta put: eachClass isMeta;
+ at: #methods put: eachClass selectors.
+ map at: eachClass put: info ].
+ map keysAndValuesDo: [ :eachClass :eachInfo |
+ eachClass == topClass
+ ifFalse: [ eachInfo at: #superclass put: (map at: eachClass superclass) ].
+ eachInfo at: #subclasses put: (eachClass subclasses collect: [ :subClass | map at: subClass ]) ].
+ ^ map at: topClass
+!
+
+classTreeExtended
+ ^ self classTreeExtended: Object
+!
+
+classTreeExtended: topClass
+ | map |
+ map := IdentityDictionary new.
+ topClass withAllSubclasses do: [ :eachClass | | info methodsInfo |
+ (info := self new)
+ at: #name put: eachClass name asString;
+ at: #comment put: eachClass comment;
+ at: #isMeta put: eachClass isMeta;
+ at: #methods put: (methodsInfo := self new).
+ eachClass methods do: [ :eachMethod | | methodInfo |
+ (methodInfo := self new)
+ at: #name put: eachMethod selector;
+ at: #numArgs put: eachMethod numArgs;
+ at: #class put: info.
+ methodsInfo at: eachMethod selector put: methodInfo ].
+ map at: eachClass put: info ].
+ map keysAndValuesDo: [ :eachClass :eachInfo |
+ eachClass == topClass
+ ifFalse: [ eachInfo at: #superclass put: (map at: eachClass superclass) ].
+ eachInfo at: #subclasses put: (eachClass subclasses collect: [ :subClass | map at: subClass ]) ].
+ ^ map at: topClass
+! !
+
+!STONTestMap class methodsFor:'ston-core'!
+
+stonName
+ ^ #TestMap
+! !
+
+!STONTestMap methodsFor:'printing'!
+
+printElementsOn: stream
+ stream
+ nextPut: $(;
+ nextPut: $#;
+ print: self size;
+ nextPut: $)
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONTestUser.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,92 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#STONTestUser
+ instanceVariableNames:'username password enabled'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Support'
+!
+
+!STONTestUser class methodsFor:'instance creation'!
+
+dummy
+ "self dummy"
+
+ | username password |
+ username := String streamContents: [ :stream |
+ stream print: 'user'; print: 999 atRandom; print: '@company'; print: 99 atRandom; print: '.com' ].
+ password := String streamContents: [ :stream |
+ stream print: 'secret'; print: 999 atRandom ].
+ ^ self new
+ username: username;
+ password: password;
+ yourself
+
+ "Modified: / 04-06-2019 / 11:05:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+! !
+
+!STONTestUser class methodsFor:'ston-core'!
+
+stonName
+ ^ #TestUser
+! !
+
+!STONTestUser methodsFor:'accessing'!
+
+enabled
+ ^ enabled
+!
+
+enabled: anObject
+ enabled := anObject
+!
+
+password
+ ^ password
+!
+
+password: anObject
+ password := anObject
+!
+
+username
+ ^ username
+!
+
+username: anObject
+ username := anObject
+! !
+
+!STONTestUser methodsFor:'comparing'!
+
+= anObject
+ "Answer whether the receiver and anObject represent the same object."
+
+ self == anObject
+ ifTrue: [ ^ true ].
+ self class = anObject class
+ ifFalse: [ ^ false ].
+ ^ username = anObject username and: [ password = anObject password and: [ enabled = anObject enabled ] ]
+!
+
+hash
+ "Answer an integer value that is related to the identity of the receiver."
+
+ ^ username hash bitXor: (password hash bitXor: enabled hash)
+! !
+
+!STONTestUser methodsFor:'initialize-release'!
+
+initialize
+ super initialize.
+ enabled := true
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONTestUser2.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,35 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+STONTestUser subclass:#STONTestUser2
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Support'
+!
+
+!STONTestUser2 class methodsFor:'ston-core'!
+
+stonName
+ ^ #TestUser2
+! !
+
+!STONTestUser2 methodsFor:'ston-core'!
+
+fromSton: stonReader
+ stonReader parseMapDo: [ :key :value |
+ key = #username ifTrue: [ username := value ].
+ key = #password ifTrue: [ password := value ].
+ key = #enabled ifTrue: [ enabled := value ] ]
+
+!
+
+stonOn: stonWriter
+ stonWriter writeObject: self streamMap: [ :dictionary |
+ dictionary
+ at: #username put: username;
+ at: #password put: password;
+ at: #enabled put: enabled ]
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONTestUser3.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,27 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+STONTestUser subclass:#STONTestUser3
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Support'
+!
+
+!STONTestUser3 class methodsFor:'ston-core'!
+
+stonAllInstVarNames
+ ^ #(username password enabled)
+!
+
+stonName
+ ^ #TestUser3
+! !
+
+!STONTestUser3 methodsFor:'ston-core'!
+
+stonShouldWriteNilInstVars
+ ^ true
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONTests.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,110 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#STONTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Facade'
+!
+
+!STONTests class methodsFor:'utilities'!
+
+fastReadFromFileNamed: path
+ ^ path asFileReference
+ readStreamDo: [ :stream |
+ STON reader
+ on: (ZnBufferedReadStream on: stream);
+ optimizeForLargeStructures;
+ next ]
+!
+
+fastWrite: object toFileNamed: path
+ ^ path asFileReference
+ writeStreamDo: [ :fileStream |
+ ZnBufferedWriteStream
+ on: fileStream
+ do: [ :stream |
+ STON writer
+ on: stream;
+ optimizeForLargeStructures;
+ nextPut: object ] ]
+!
+
+readFromFileNamed: path
+ ^ path asFileReference
+ readStreamDo: [ :stream |
+ STON reader
+ on: stream;
+ next ]
+!
+
+write: object toFileNamed: path
+ ^ path asFileReference
+ writeStreamDo: [ :stream |
+ STON writer
+ on: stream;
+ nextPut: object ]
+! !
+
+!STONTests methodsFor:'tests'!
+
+testFromString
+ | object |
+ object := STON listClass withAll: { 1. 0. -1. true. false. nil }.
+ self assert: (STON fromString: '[1,0,-1,true,false,nil]') = object
+!
+
+testFromStringWithComments
+ | object |
+ object := STON listClass withAll: { 1. 0. -1. true. false. nil }.
+ self
+ assert: (STON fromStringWithComments: '// comment\[1, /* comment */ 0, -1, true, false, nil] // comment' withCRs)
+ equals: object
+!
+
+testPrettyPrinting
+ | object |
+ object := STONTestUser dummy.
+ self assert: (STON fromString: (STON toStringPretty: object)) = object.
+ object := STONTestDomainObject dummy.
+ self assert: (STON fromString: (STON toStringPretty: object)) = object
+!
+
+testRoomExitCycles
+ | model room1 room2 exit1 exit2 ston object |
+ (room1 := STONTestMap new) at: #name put: 'Room 1'.
+ (room2 := STONTestMap new) at: #name put: 'Room 2'.
+ (exit1 := STONTestMap new)
+ at: #name put: 'Exit 1';
+ at: #origin put: room1;
+ at: #destination put: room2.
+ (exit2 := STONTestMap new)
+ at: #name put: 'Exit 2';
+ at: #origin put: room2;
+ at: #destination put: room1.
+ room1 at: #exit put: exit1.
+ room2 at: #exit put: exit2.
+ model := Array with: room1 with: room2.
+ ston := STON toString: model.
+ object := STON fromString: ston.
+ "We can't just compare because this is a recursive datastructure"
+ self assert: (object first at: #name) equals: 'Room 1'.
+ self assert: (object second at: #name) equals: 'Room 2'.
+ self assert: ((object first at: #exit) at: #name) equals: 'Exit 1'.
+ self assert: ((object second at: #exit) at: #name) equals: 'Exit 2'.
+ self assert: ((object first at: #exit) at: #origin) == object first.
+ self assert: ((object first at: #exit) at: #destination) == object second.
+ self assert: ((object second at: #exit) at: #origin) == object second.
+ self assert: ((object second at: #exit) at: #destination) == object first.
+ "Try writing again the parse model"
+ self assert: (STON toString: object) equals: ston
+!
+
+testToString
+ | object |
+ object := STON listClass withAll: { 1. 0. -1. true. false. nil }.
+ self assert: (STON toString: object) = '[1,0,-1,true,false,nil]'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONWriteAsciiOnlyReadTests.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,29 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+STONWriteReadTests subclass:#STONWriteAsciiOnlyReadTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Write-Read'
+!
+
+!STONWriteAsciiOnlyReadTests methodsFor:'private'!
+
+serialize: anObject
+ ^ String streamContents: [ :stream |
+ STON writer
+ on: stream;
+ asciiOnly: true;
+ nextPut: anObject ]
+!
+
+serializeJson: anObject
+ ^ String streamContents: [ :stream |
+ STON jsonWriter
+ on: stream;
+ asciiOnly: true;
+ nextPut: anObject ]
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONWritePrettyPrinterReadTests.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,29 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+STONWriteReadTests subclass:#STONWritePrettyPrinterReadTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Write-Read'
+!
+
+!STONWritePrettyPrinterReadTests methodsFor:'private'!
+
+serialize: anObject
+ ^ String streamContents: [ :stream |
+ STON writer
+ on: stream;
+ prettyPrint: true;
+ nextPut: anObject ]
+!
+
+serializeJson: anObject
+ ^ String streamContents: [ :stream |
+ STON jsonWriter
+ on: stream;
+ prettyPrint: true;
+ nextPut: anObject ]
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONWriteReadCommentsTests.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,29 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+STONWriteReadTests subclass:#STONWriteReadCommentsTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Write-Read'
+!
+
+!STONWriteReadCommentsTests methodsFor:'private'!
+
+materialize: string
+ ^ STON reader
+ on: (STONCStyleCommentsSkipStream on: string readStream);
+ optimizeForLargeStructures;
+ next
+!
+
+serialize: anObject
+ ^ String streamContents: [ :stream |
+ stream << '/* initial comment */'.
+ STON writer
+ on: stream;
+ nextPut: anObject.
+ stream << '/* final comment */' ]
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONWriteReadTests.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,389 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#STONWriteReadTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Write-Read'
+!
+
+!STONWriteReadTests methodsFor:'private'!
+
+materialize: string
+ ^ STON reader
+ on: string readStream;
+ next
+!
+
+serialize: anObject
+ ^ String streamContents: [ :stream |
+ STON writer
+ on: stream;
+ nextPut: anObject ]
+!
+
+serializeAndMaterialize: object
+ | serialization materialization |
+ serialization := self serialize: object.
+ materialization := self materialize: serialization.
+ self assert: object equals: materialization
+
+!
+
+serializeAndMaterializeJsonMode: object
+ | serialization materialization |
+ serialization := self serializeJson: object.
+ materialization := self materialize: serialization.
+ self assert: object equals: materialization
+!
+
+serializeJson: anObject
+ ^ String streamContents: [ :stream |
+ STON jsonWriter
+ on: stream;
+ nextPut: anObject ]
+! !
+
+!STONWriteReadTests methodsFor:'tests'!
+
+testAssociations
+ | associations |
+ associations := OrderedCollection new.
+ 1 to: 10 do: [ :each |
+ associations add: each -> each printString ].
+ self serializeAndMaterialize: associations
+!
+
+testCharacters
+ | characters |
+ characters := STON listClass withAll: ($a to: $z), ($A to: $Z).
+ self serializeAndMaterialize: characters
+!
+
+testClasses
+ | classes |
+ classes := STON listClass withAll: { Point. Integer. Object }.
+ self serializeAndMaterialize: classes.
+ classes := STON listClass withAll: { Point class. Integer class. Object class }.
+ self serializeAndMaterialize: classes.
+ classes := STON listClass withAll: { Class. Metaclass. Class class. Point class class }.
+ self serializeAndMaterialize: classes.
+!
+
+testCollections
+ | collections |
+ collections := STON listClass withAll: {
+ #(1 2 3).
+ OrderedCollection withAll: #(1 2 3).
+ Set withAll: #(1 2 3).
+ Bag withAll: #(1 2 2 3).
+ Dictionary new at: 1 put: 1; at: 2 put: 2; yourself.
+ #[1 2 3].
+ #(1 2 3) asIntegerArray.
+ #(1 2 3) asFloatArray }.
+ self serializeAndMaterialize: collections
+!
+
+testCollectionsStructured
+ | collections one two |
+ one := 1@2.
+ two := 2@3.
+ collections := STON listClass withAll: {
+ Bag withAll: { one. two. one. two. one }.
+ Set withAll: { one. two. one. two. one }.
+ OrderedCollection withAll: { one. two. one. two. one }.
+ }.
+ self serializeAndMaterialize: collections
+!
+
+testColors
+ | colors |
+ colors := STON listClass withAll: {
+ Color red.
+ Color red copy alpha: 0.4.
+ Color red lighter lighter }.
+ self serializeAndMaterialize: colors
+
+ "Modified: / 04-06-2019 / 11:21:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testCustomAssociations
+ | associations |
+ associations := OrderedCollection new.
+ associations add: #foo->100.
+ associations add: (STONTestAssociation key: #foo value:100).
+ self serializeAndMaterialize: associations
+!
+
+testDatesAndTimes
+ | datesAndTimes |
+ datesAndTimes := STON listClass withAll: {
+ Time now.
+ Date today.
+ DateAndTime now }.
+ self serializeAndMaterialize: datesAndTimes
+!
+
+testDiskFiles
+ | diskFiles |
+ diskFiles := STON listClass withAll: {
+ FileLocator image asFileReference.
+ FileLocator workingDirectory asAbsolute.
+ 'foo/bar/readme.txt' asFileReference.
+ './readme.txt' asFileReference.
+ (FileLocator home / 'foo.txt') asFileReference }.
+ self serializeAndMaterialize: diskFiles
+!
+
+testDomainObject
+ | object objects |
+ object := STONTestDomainObject dummy.
+ self serializeAndMaterialize: object.
+ objects := STON listClass streamContents: [ :stream |
+ 10 timesRepeat: [ stream nextPut: STONTestDomainObject dummy ] ].
+ self serializeAndMaterialize: objects.
+ objects := STON mapClass new.
+ 10 timesRepeat: [ | newObject |
+ newObject := STONTestDomainObject dummy.
+ objects at: newObject integer put: newObject ].
+ self serializeAndMaterialize: objects.
+!
+
+testEmpty
+ | empty |
+ empty := STON listClass new.
+ self serializeAndMaterialize: empty.
+ empty := STON mapClass new.
+ self serializeAndMaterialize: empty.
+!
+
+testFileSystemSupport
+ | fileReferences fileLocators |
+ fileReferences := STON listClass withAll: {
+ FileLocator image asFileReference.
+ FileLocator workingDirectory asFileReference.
+ (FileLocator home / 'foo.txt') asFileReference }.
+ self serializeAndMaterialize: fileReferences.
+ fileLocators := STON listClass withAll: {
+ FileLocator image.
+ FileLocator workingDirectory.
+ FileLocator home / 'foo.txt' }.
+ self serializeAndMaterialize: fileLocators.
+!
+
+testFloats
+ | floats serialization materialization |
+ floats := STON listClass withAll: ((-10 to: 10) collect: [ :each | each * Float pi ]).
+ serialization := self serialize: floats.
+ materialization := self materialize: serialization.
+ self assert: floats size = materialization size.
+ 1 to: floats size do: [:index | | float |
+ float := floats at: index.
+ "Use #closeTo: instead of #= to increase portability"
+ self assert: (float closeTo: (materialization at: index)) ]
+!
+
+testFractions
+ | fractions |
+ fractions := STON listClass withAll: (-2/3 to: 2/3 by: 1/3).
+ self serializeAndMaterialize: fractions
+!
+
+testIdentityCollections
+ | collections |
+ collections := STON listClass withAll: {
+ IdentitySet withAll: #(1 2 3).
+ IdentityDictionary new at: 1 put: 1; at: 2 put: 2; yourself.
+ IdentityBag withAll: { #A. #B. #A. #B. #A } }.
+ self serializeAndMaterialize: collections
+!
+
+testIntervals
+ | intervals |
+ intervals := STON listClass withAll: {
+ 1 to: 10.
+ 1 to: 10 by: 2.
+ 100 to: 50 by: -5 }.
+ self serializeAndMaterialize: intervals
+!
+
+testJsonMode
+ | object |
+ object := STON listClass withAll: {
+ "/ Float pi.
+ 'Hello World'.
+ true.
+ nil.
+ STON listClass withAll: #( 1 2 3) asByteArray.
+ STON mapClass new
+ at: 'x' put: 1;
+ at: 'y' put: 2;
+ yourself
+ }.
+ self serializeAndMaterializeJsonMode: object
+
+ "Modified: / 04-06-2019 / 11:20:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testKnownObjects
+ | knownObject ston object |
+ knownObject := STONTestKnownObject new.
+ "make sure the system of remembering instances works"
+ self assert: (STONTestKnownObject fromId: knownObject id asString) equals: knownObject.
+ self assert: (STONTestKnownObject fromId: knownObject id asString) == knownObject.
+ "only the id string is serialized"
+ ston := self serialize: knownObject.
+ "upon serialization, objects with known id strings come from the remembered instances"
+ object := self materialize: ston.
+ self assert: object equals: knownObject.
+ self assert: object == knownObject.
+ "not just the id is equal, but the rest of the object too"
+ self assert: object description equals: knownObject description.
+
+ STONTestKnownObject resetKnownObjects.
+!
+
+testMimeTypes
+ | mimeTypes |
+ mimeTypes := STON listClass withAll: {
+ ZnMimeType applicationJson.
+ ZnMimeType textPlain }.
+ self serializeAndMaterialize: mimeTypes
+!
+
+testOrderedDictionary
+ "OrderedDictionary is special because it does not inherit from Dictionary.
+ It might also not exist in some dialects, where this test could be skipped."
+
+ | dictionaries orderedDictionaryClass orderedIdentityDictionaryClass |
+ orderedDictionaryClass := Smalltalk at: #OrderedDictionary ifAbsent: [ Dictionary ].
+ orderedIdentityDictionaryClass := Smalltalk at: #OrderedIdentityDictionary ifAbsent: [ IdentityDictionary ].
+ dictionaries := STON listClass withAll: {
+ orderedDictionaryClass new at: 1 put: 1; at: 2 put: 2; yourself.
+ orderedDictionaryClass new at: #a put: 1; at: #b put: -2; at: #c put: 0; yourself.
+ orderedDictionaryClass new.
+ orderedIdentityDictionaryClass new at: 1 put: 1; at: 2 put: 2; yourself.
+ orderedIdentityDictionaryClass new at: #a put: 1; at: #b put: -2; at: #c put: 0; yourself.
+ orderedIdentityDictionaryClass new }.
+ self serializeAndMaterialize: dictionaries
+!
+
+testPrimitives
+ | primitives |
+ primitives := STON listClass withAll: { true. false. nil }.
+ self serializeAndMaterialize: primitives
+!
+
+testScaledDecimals
+ | fractions |
+ fractions := STON listClass withAll: (-2/3s2 to: 2/3s2 by: 1/3s2).
+ self serializeAndMaterialize: fractions
+!
+
+testSmallDictionary
+ "SmallDictionary is special because it does not inherit from Dictionary.
+ It might also not exist in some dialects, where this test could be skipped."
+
+ | dictionaries smallDictionaryClass |
+ smallDictionaryClass := Smalltalk at: #SmallDictionary ifAbsent: [ Dictionary ].
+ dictionaries := STON listClass withAll: {
+ smallDictionaryClass new at: 1 put: 1; at: 2 put: 2; yourself.
+ smallDictionaryClass new at: 1 put: 1; at: 2 put: 2; yourself.
+ smallDictionaryClass new }.
+ self serializeAndMaterialize: dictionaries
+!
+
+testSmallIntegers
+ | integers |
+ integers := STON listClass withAll: (-10 to: 10).
+ self serializeAndMaterialize: integers
+!
+
+testSpecialCharacters
+ | primitives |
+ primitives := STON listClass withAll: {
+ String withAll: { Character tab. Character lf. Character cr }.
+ String withAll: { $'. $". $\. $/ }.
+ 'élèves français'.
+ 'Düsseldorf Königsallee'.
+ #(1 10 20 30 127 140 150 160 200 255) collect: #asCharacter as: String }.
+ self serializeAndMaterialize: primitives
+!
+
+testStrings
+ | strings |
+ strings := Collection allSubclasses
+ collect: [ :each | each name asString ].
+ self serializeAndMaterialize: strings.
+ strings := {
+ 'foo'. 'Foo BAR'. ''. ' \\'''.
+ 'élève en Français'.
+ String with: (Character codePoint: 12354) "HIRAGANA LETTER A" }.
+ self serializeAndMaterialize: strings.
+!
+
+testSymbols
+ | symbols |
+ self serializeAndMaterialize: #( #bytes #'' ).
+ symbols := Collection allSubclasses collect: [ :each | each name ].
+ self serializeAndMaterialize: symbols
+!
+
+testTextAndRunArray
+ | texts |
+ texts := {
+ 'Text!!' asText.
+ (Text string: 'I am bold' attribute: TextEmphasis bold), ' and I am normal text'.
+ Text new }.
+ self serializeAndMaterialize: texts
+!
+
+testURLs
+ | urls |
+ urls := STON listClass withAll: {
+ 'https://pharo.org/files/pharo.png' asUrl.
+ 'mailto:sven@stfx.eu' asUrl.
+ 'file:///var/log/system.log' asUrl.
+ 'scheme://user:password@host:123/var/log/system.log?foo=1&bar#frag' asUrl }.
+ self serializeAndMaterialize: urls
+!
+
+testUUIDs
+ | uuids |
+ uuids := STON listClass withAll: {
+ UUID new.
+ UUID new.
+ UUID nilUUID }.
+ self serializeAndMaterialize: uuids
+!
+
+testUser
+ | user users |
+ user := STONTestUser dummy.
+ self serializeAndMaterialize: user.
+ users := STON listClass streamContents: [ :stream |
+ 10 timesRepeat: [ stream nextPut: STONTestUser dummy ] ].
+ self serializeAndMaterialize: users.
+ users := STON mapClass new.
+ 10 timesRepeat: [ | newUser |
+ newUser := STONTestUser dummy.
+ users at: newUser username put: newUser ].
+ self serializeAndMaterialize: users.
+!
+
+testUser2
+ | user users |
+ user := STONTestUser2 dummy.
+ self serializeAndMaterialize: user.
+ users := STON listClass streamContents: [ :stream |
+ 10 timesRepeat: [ stream nextPut: STONTestUser2 dummy ] ].
+ self serializeAndMaterialize: users.
+ users := STON mapClass new.
+ 10 timesRepeat: [ | newUser |
+ newUser := STONTestUser2 dummy.
+ users at: newUser username put: newUser ].
+ self serializeAndMaterialize: users.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/STONWriterTests.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,428 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#STONWriterTests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'STON-Tests-Writer'
+!
+
+!STONWriterTests methodsFor:'private'!
+
+serialize: anObject
+ ^ String streamContents: [ :stream |
+ STON writer
+ on: stream;
+ nextPut: anObject ]
+!
+
+serializeAsciiOnly: anObject
+ ^ String streamContents: [ :stream |
+ STON writer
+ on: stream;
+ asciiOnly: true;
+ nextPut: anObject ]
+!
+
+serializeJson: anObject
+ ^ String streamContents: [ :stream |
+ STON jsonWriter
+ on: stream;
+ nextPut: anObject ]
+!
+
+serializePretty: anObject
+ ^ String streamContents: [ :stream |
+ STON writer
+ on: stream;
+ prettyPrint: true;
+ nextPut: anObject ]
+! !
+
+!STONWriterTests methodsFor:'tests'!
+
+testAssociation
+ self assert: (self serialize: 'foo' -> 1) = '''foo'':1'.
+ self assert: (self serialize: #bar -> 2) = '#bar:2'.
+ self assert: (self serialize: 'foo bar' -> #ok) = '''foo bar'':#ok'.
+ self assert: (self serialize: 123 -> 456) = '123:456'
+!
+
+testBag
+ self
+ assert: (self serialize: (Bag withAll: #(a a)))
+ equals: 'Bag{#a:2}'.
+ self
+ assert: (self serialize: Bag new)
+ equals: 'Bag{}'
+!
+
+testBoolean
+ self assert: (self serialize: true) = 'true'.
+ self assert: (self serialize: false) = 'false'
+!
+
+testByteArray
+ self assert: (self serialize: #(1 2 3) asByteArray) = 'ByteArray[''010203'']'
+!
+
+testClass
+ self assert: (self serialize: Point) = 'Class[#Point]'
+!
+
+testColor
+ self
+ assert: (self serialize: Color red)
+ equals: 'Color[#red]'.
+ self
+ assert: (self serialize: (Color red copy alpha: 0.4))
+ equals: 'Color{#red:1.0,#green:0.0,#blue:0.0,#alpha:0.4}'.
+ self
+ assert: (self serialize: Color red lighter lighter)
+ equals: 'Color{#red:1.0,#green:0.061,#blue:0.061,#alpha:1.0}'.
+
+ "Modified: / 20-05-2020 / 13:25:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testCustomNewline
+ | output |
+ output := String streamContents: [ :out |
+ (STON writer on: out)
+ newLine: String lf;
+ prettyPrint: true;
+ nextPut: #( 1 ) ].
+ self
+ assert: output
+ equals: ('[\ 1\]' withCRs replaceAll: Character cr with: Character lf)
+!
+
+testDate
+ | date |
+ date := (Date year: 2012 month: 1 day: 1) translateToUTC.
+ self assert: (self serialize: date) equals: 'Date[''2012-01-01Z'']'.
+ date := (Date year: 2012 month: 1 day: 1) translateTo: 1 hour.
+ self assert: (self serialize: date) equals: 'Date[''2012-01-01+01:00'']'.
+!
+
+testDateAndTime
+ | dateAndTime |
+ dateAndTime := DateAndTime year: 2012 month: 1 day: 1 hour: 6 minute: 30 second: 15 offset: 1 hour.
+ self assert: (self serialize: dateAndTime) = 'DateAndTime[''2012-01-01T06:30:15+01:00'']'
+!
+
+testDictionary
+ | collection |
+ collection := STON mapClass new at: 1 put: 1; at: 2 put: 2; yourself.
+ self assert: (self serialize: collection) = '{1:1,2:2}'.
+ self assert: (self serialize: STON mapClass new) = '{}'.
+!
+
+testDictionaryWithComplexKeys
+ | collection |
+ collection := STON mapClass new at: true put: 1; at: #(foo) put: 2; yourself.
+ self assert: (#('{true:1,[#foo]:2}' '{[#foo]:2,true:1}') includes: (self serialize: collection))
+!
+
+testDiskFile
+ self assert: (self serialize: 'foo.txt' asFileReference) equals: 'FILE[''foo.txt'']'.
+ self assert: (self serialize: '/tmp/foo.txt' asFileReference) equals: 'FILE[''/tmp/foo.txt'']'.
+ self assert: (self serialize: 'tmp/foo.txt' asFileReference) equals: 'FILE[''tmp/foo.txt'']'.
+ self assert: (self serialize: '/tmp' asFileReference) equals: 'FILE[''/tmp'']'.
+ self assert: (self serialize: '/tmp/' asFileReference) equals: 'FILE[''/tmp'']'.
+!
+
+testDoubleQuotedString
+ | string |
+ self assert: (self serializeJson: 'foo') = '"foo"'.
+ self assert: (self serializeJson: 'FOO') = '"FOO"'.
+ self assert: (self serializeJson: 'élève en Français') = '"élève en Français"'.
+ string := String withAll: {
+ $". $'. $\. $/. Character tab. Character cr. Character lf. Character newPage. Character backspace }.
+ "Note that in JSON mode, double quotes get escaped, and single quotes not"
+ self assert: (self serializeJson: string) equals: '"\"''\\/\t\r\n\f\b"'.
+!
+
+testEmptyArrayPretty
+ self assert: (self serializePretty: STON listClass new) equals: '[ ]'
+!
+
+testEmptyDictionaryPretty
+ self assert: (self serializePretty: STON mapClass new) equals: '{ }'
+!
+
+testFloat
+ self assert: (self serialize: 1.5) = '1.5'.
+ self assert: (self serialize: 0.0) = '0.0'.
+ self assert: (self serialize: -1.5) = '-1.5'.
+ self assert: ((self serialize: Float pi) beginsWith: '3.14159').
+ self assert: ((self serialize: (1/3) asFloat) beginsWith: '0.333').
+ self assert: (self serialize: (10 raisedTo: 100) asFloat) = '1.0e100'.
+ self assert: (self serialize: (10 raisedTo: -50) asFloat) = '1.0e-50'.
+ self assert: (self serialize: (10 raisedTo: -50) asFloat negated) = '-1.0e-50'.
+!
+
+testFraction
+ self assert: (self serialize: 1/3) equals: '1/3'.
+ self assert: (self serialize: -1/3) equals: '-1/3'.
+ self assert: (self serialize: 10/100) equals: '1/10'.
+ self assert: (self serialize: 100/10) equals: '10'.
+ self assert: (self serialize: 123/123) equals: '1'.
+ self assert: (self serialize: 100/11) equals: '100/11'.
+!
+
+testIdentityDictionary
+ | collection |
+ collection := IdentityDictionary new at: 1 put: 1; at: 2 put: 2; yourself.
+ self assert: (self serialize: collection) = 'IdentityDictionary{1:1,2:2}'.
+ self assert: (self serialize: IdentityDictionary new) = 'IdentityDictionary{}'.
+!
+
+testInteger
+ self assert: (self serialize: 1) = '1'.
+ self assert: (self serialize: 0) = '0'.
+ self assert: (self serialize: -1) = '-1'.
+ self assert: (self serialize: 1234567890) = '1234567890'.
+ self assert: (self serialize: -1234567890) = '-1234567890'
+!
+
+testIsSimpleSymbol
+ self assert: (STON writer isSimpleSymbol: #foo).
+ self assert: (STON writer isSimpleSymbol: #az).
+ self assert: (STON writer isSimpleSymbol: #AZ).
+ self assert: (STON writer isSimpleSymbol: #N0123456789).
+ self assert: (STON writer isSimpleSymbol: #foo123).
+ self assert: (STON writer isSimpleSymbol: #'Foo/Bar').
+ self assert: (STON writer isSimpleSymbol: #'Foo.Bar').
+ self assert: (STON writer isSimpleSymbol: #'Foo-Bar').
+ self assert: (STON writer isSimpleSymbol: #'Foo_Bar').
+ self assert: (STON writer isSimpleSymbol: #foo).
+ self deny: (STON writer isSimpleSymbol: #'#^&$%')
+!
+
+testKeepingNewLines
+ | input result output |
+ input := 'line ending with CR', String return,
+ 'line ending with LF', String lf,
+ 'line ending with CRLF', String crlf.
+ output := '''line ending with CR', String crlf,
+ 'line ending with LF', String crlf,
+ 'line ending with CRLF', String crlf, ''''.
+ result := String streamContents: [ :out |
+ (STON writer on: out) newLine: String crlf; keepNewLines: true; nextPut: input ].
+ self assert: result equals: output.
+ output := '''line ending with CR', String return,
+ 'line ending with LF', String return,
+ 'line ending with CRLF', String return, ''''.
+ result := String streamContents: [ :out |
+ (STON writer on: out) newLine: String return; keepNewLines: true; nextPut: input ].
+ self assert: result equals: output
+
+ "Modified: / 04-06-2019 / 10:52:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testList
+ self assert: (self serialize: (STON listClass withAll: #(1 2 3))) = '[1,2,3]'.
+ self assert: (self serialize: STON listClass new) = '[]'.
+ self assert: (self serialize: (STON listClass withAll: { 1. -1. 0. #foo. 'a b c'. true. false. nil })) = '[1,-1,0,#foo,''a b c'',true,false,nil]'
+!
+
+testMap
+ | map |
+ (map := STON mapClass new)
+ at: #foo put: 1;
+ at: #bar put: 2.
+ self assert: (self serialize: map) = '{#foo:1,#bar:2}'.
+ self assert: (self serialize: STON mapClass new) = '{}'.
+ map removeAll.
+ map at: 'foo bar' put: #ok.
+ self assert: (self serialize: map) = '{''foo bar'':#ok}'.
+ map removeAll.
+ map at: 123 put: 456.
+ self assert: (self serialize: map) = '{123:456}'.
+
+!
+
+testMetaclass
+ self assert: (self serialize: Point class) = 'Metaclass[#Point]'
+!
+
+testMimeType
+ self
+ assert: (self serialize: ZnMimeType applicationJson)
+ equals: 'MimeType[''application/json'']'.
+ self
+ assert: (self serialize: ZnMimeType textPlain)
+ equals: 'MimeType[''text/plain;charset=utf-8'']'.
+!
+
+testNil
+ self assert: (self serialize: nil) = 'nil'
+!
+
+testNonBMPCharacterEncoding
+ "Characters not in the Basic Multilingual Plane are encoded as a UTF-16 surrogate pair"
+
+ | string json |
+ string := String with: 16r1D11E asCharacter. "MUSICAL SYMBOL G CLEF"
+ json := String streamContents: [ :out |
+ (STON writer on: out) asciiOnly: true; nextPut: string ].
+ self assert: json equals: '''\uD834\uDD1E'''
+!
+
+testNull
+ self assert: (self serializeJson: nil) equals: 'null'
+!
+
+testOrderedCollection
+ | collection |
+ collection := OrderedCollection with: 1 with: 2 with: 3.
+ self assert: (self serialize: collection) = 'OrderedCollection[1,2,3]'.
+ self assert: (self serialize: OrderedCollection new) = 'OrderedCollection[]'.
+!
+
+testPoint
+ self assert: (self serialize: 1@2) = 'Point[1,2]'
+!
+
+testReferenceCycle
+ | array |
+ array := STON listClass with: 1 with: nil.
+ array at: 2 put: array.
+ self assert: (self serialize: array) = '[1,@1]'.
+!
+
+testReferenceSharing
+ | array one |
+ one := { #one }.
+ array := STON listClass with: one with: one with: one.
+ self assert: (self serialize: array) = '[[#one],@2,@2]'.
+!
+
+testReferenceSharingError
+ | serializer array one |
+ serializer := [ :object |
+ String streamContents: [ :stream |
+ STON writer
+ on: stream;
+ referencePolicy: #error;
+ nextPut: object ] ].
+ one := { #one }.
+ array := STON listClass with: one with: one with: one.
+ self
+ should: [ (serializer value: array) = '[[#one],[#one],[#one]]' ]
+ raise: STONWriterError
+!
+
+testReferenceSharingIgnore
+ | serializer array one |
+ serializer := [ :object |
+ String streamContents: [ :stream |
+ STON writer
+ on: stream;
+ referencePolicy: #ignore;
+ nextPut: object ] ].
+ one := { #one }.
+ array := STON listClass with: one with: one with: one.
+ self assert: (serializer value: array) = '[[#one],[#one],[#one]]'.
+!
+
+testRestrictedClassesInJsonMode
+ self should: [ self serializeJson: 1@2 ] raise: STONWriterError.
+ self should: [ self serializeJson: #foo->100 ] raise: STONWriterError.
+ self should: [ self serializeJson: STONTestUser dummy ] raise: STONWriterError.
+!
+
+testScaledDecimal
+ self assert: (self serialize: 1/3s2) equals: '1/3s2'.
+ self assert: (self serialize: -1/3s2) equals: '-1/3s2'.
+ self assert: (self serialize: 1/3s10) equals: '1/3s10'.
+ self assert: (self serialize: -1/3s10) equals: '-1/3s10'.
+!
+
+testString
+ | string |
+ self assert: (self serialize: 'foo') = '''foo'''.
+ self assert: (self serialize: 'FOO') = '''FOO'''.
+ self assert: (self serializeAsciiOnly: 'élève en Français') = '''\u00E9l\u00E8ve en Fran\u00E7ais'''.
+ self assert: (self serialize: 'élève en Français') = '''élève en Français'''.
+ string := String withAll: {
+ $". $'. $\. $/. Character tab. Character cr. Character lf. Character newPage. Character backspace }.
+ self assert: (self serialize: string) equals: '''"\''\\/\t\r\n\f\b'''.
+!
+
+testSymbol
+ self assert: (self serialize: #foo) = '#foo'.
+ self assert: (self serialize: #FOO) = '#FOO'.
+ self assert: (self serialize: #bytes) = '#bytes'.
+ self assert: (self serialize: #'foo.bar') = '#foo.bar'.
+ self assert: (self serialize: #'foo-bar') = '#foo-bar'.
+ self assert: (self serialize: #'foo_bar') = '#foo_bar'.
+ self assert: (self serialize: #'foo/bar') = '#foo/bar'.
+ self assert: (self serialize: #'foo bar') = '#''foo bar'''.
+ self assert: (self serialize: #foo123) = '#foo123'.
+!
+
+testSymbolAsString
+ self assert: (self serializeJson: #foo) = '"foo"'.
+ self assert: (self serializeJson: #'FOO') = '"FOO"'.
+!
+
+testTime
+ | time |
+ time := Time hour: 6 minute: 30 second: 15.
+ self assert: (self serialize: time) equals: 'Time[''06:30:15'']'.
+ time := Time hour: 6 minute: 30 second: 15 nanoSecond: 123.
+ self assert: (self serialize: time) equals: 'Time[''06:30:15.000000123'']'.
+!
+
+testURL
+ self
+ assert: (self serialize: 'https://pharo.org/files/pharo.png' asUrl)
+ equals: 'URL[''https://pharo.org/files/pharo.png'']'.
+ self
+ assert: (self serialize: 'mailto:sven@stfx.eu' asUrl)
+ equals: 'URL[''mailto:sven@stfx.eu'']'.
+ self
+ assert: (self serialize: 'file:///var/log/system.log' asUrl)
+ equals: 'URL[''file:///var/log/system.log'']'.
+ self
+ assert: (self serialize: 'scheme://user:password@host:123/var/log/system.log?foo=1&bar#frag' asUrl)
+ equals: 'URL[''scheme://user:password@host:123/var/log/system.log?foo=1&bar#frag'']'.
+!
+
+testUser
+ | user |
+ (user := STONTestUser new)
+ username: 'john@foo.com';
+ password: 'secret1'.
+ self
+ assert: (self serialize: user)
+ equals: 'TestUser{#username:''john@foo.com'',#password:''secret1'',#enabled:true}'
+!
+
+testUser2
+ | user |
+ (user := STONTestUser2 new)
+ username: 'john@foo.com';
+ password: 'secret1'.
+ self
+ assert: (self serialize: user)
+ equals: 'TestUser2{#username:''john@foo.com'',#password:''secret1'',#enabled:true}'
+!
+
+testUser3Nil
+ | user |
+ user := STONTestUser3 new.
+ self
+ assert: (self serialize: user)
+ equals: 'TestUser3{#username:nil,#password:nil,#enabled:true}'
+!
+
+testUserNil
+ | user |
+ user := STONTestUser new.
+ self assert: (self serialize: user) equals: 'TestUser{#enabled:true}'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/abbrev.stc Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,21 @@
+# automagically generated by the project definition
+# this file is needed for stc to be able to compile modules independently.
+# it provides information about a classes filename, category and especially namespace.
+STONCStyleCommentsSkipStreamTests STONCStyleCommentsSkipStreamTests stx:goodies/ston/tests 'STON-Tests-Reader' 1
+STONJSONTests STONJSONTests stx:goodies/ston/tests 'STON-Tests-Facade' 1
+STONReaderTests STONReaderTests stx:goodies/ston/tests 'STON-Tests-Reader' 1
+STONTestAssociation STONTestAssociation stx:goodies/ston/tests 'STON-Tests-Support' 0
+STONTestDomainObject STONTestDomainObject stx:goodies/ston/tests 'STON-Tests-Support' 0
+STONTestKnownObject STONTestKnownObject stx:goodies/ston/tests 'STON-Tests-Support' 0
+STONTestMap STONTestMap stx:goodies/ston/tests 'STON-Tests-Support' 0
+STONTestUser STONTestUser stx:goodies/ston/tests 'STON-Tests-Support' 0
+STONTests STONTests stx:goodies/ston/tests 'STON-Tests-Facade' 1
+STONWriteReadTests STONWriteReadTests stx:goodies/ston/tests 'STON-Tests-Write-Read' 1
+STONWriterTests STONWriterTests stx:goodies/ston/tests 'STON-Tests-Writer' 1
+stx_goodies_ston_tests stx_goodies_ston_tests stx:goodies/ston/tests '* Projects & Packages *' 3
+STONLargeWriteReadTests STONLargeWriteReadTests stx:goodies/ston/tests 'STON-Tests-Write-Read' 1
+STONTestUser2 STONTestUser2 stx:goodies/ston/tests 'STON-Tests-Support' 0
+STONTestUser3 STONTestUser3 stx:goodies/ston/tests 'STON-Tests-Support' 0
+STONWriteAsciiOnlyReadTests STONWriteAsciiOnlyReadTests stx:goodies/ston/tests 'STON-Tests-Write-Read' 1
+STONWritePrettyPrinterReadTests STONWritePrettyPrinterReadTests stx:goodies/ston/tests 'STON-Tests-Write-Read' 1
+STONWriteReadCommentsTests STONWriteReadCommentsTests stx:goodies/ston/tests 'STON-Tests-Write-Read' 1
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/bc.mak Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,103 @@
+# $Header$
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: stx_goodies_ston_tests.
+#
+# Warning: once you modify this file, do not rerun
+# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
+#
+# Notice, that the name bc.mak is historical (from times, when only borland c was supported).
+# This file contains make rules for the win32 platform using either borland-bcc or visual-c.
+# It shares common definitions with the unix-make in Make.spec.
+# The bc.mak supports the following targets:
+# bmake - compile all st-files to a classLib (dll)
+# bmake clean - clean all temp files
+# bmake clobber - clean all
+#
+# Historic Note:
+# this used to contain only rules to make with borland
+# (called via bmake, by "make.exe -f bc.mak")
+# this has changed; it is now also possible to build using microsoft visual c
+# (called via vcmake, by "make.exe -f bc.mak -DUSEVC")
+#
+TOP=..\..\..
+INCLUDE_TOP=$(TOP)\..
+
+
+
+!INCLUDE $(TOP)\rules\stdHeader_bc
+
+!INCLUDE Make.spec
+
+LIBNAME=libstx_goodies_ston_tests
+MODULE_PATH=goodies\ston\tests
+RESFILES=stx_goodies_ston_testsWINrc.$(RES)
+
+
+
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\ston -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2 -I$(INCLUDE_TOP)\stx\libview
+LOCALDEFINES=
+
+STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
+LOCALLIBS=
+
+OBJS= $(COMMON_OBJS) $(WIN32_OBJS)
+
+ALL:: classLibRule
+
+classLibRule: $(OUTDIR) $(OUTDIR)$(LIBNAME).dll
+
+!INCLUDE $(TOP)\rules\stdRules_bc
+
+# build all mandatory prerequisite packages (containing superclasses) for this package
+prereq:
+ pushd ..\..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\sunit & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+
+
+
+
+
+
+
+test: $(TOP)\goodies\builder\reports
+ pushd $(TOP)\goodies\builder\reports & $(MAKE_BAT)
+ $(TOP)\goodies\builder\reports\report-runner.bat -D . -r Builder::TestReport -p $(PACKAGE)
+
+clean::
+ -del *.$(CSUFFIX)
+
+
+# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)STONCStyleCommentsSkipStreamTests.$(O) STONCStyleCommentsSkipStreamTests.$(C) STONCStyleCommentsSkipStreamTests.$(H): STONCStyleCommentsSkipStreamTests.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONJSONTests.$(O) STONJSONTests.$(C) STONJSONTests.$(H): STONJSONTests.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONReaderTests.$(O) STONReaderTests.$(C) STONReaderTests.$(H): STONReaderTests.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONTestAssociation.$(O) STONTestAssociation.$(C) STONTestAssociation.$(H): STONTestAssociation.st $(INCLUDE_TOP)\stx\libbasic\Association.$(H) $(INCLUDE_TOP)\stx\libbasic\LookupKey.$(H) $(INCLUDE_TOP)\stx\libbasic\Magnitude.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONTestDomainObject.$(O) STONTestDomainObject.$(C) STONTestDomainObject.$(H): STONTestDomainObject.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONTestKnownObject.$(O) STONTestKnownObject.$(C) STONTestKnownObject.$(H): STONTestKnownObject.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONTestMap.$(O) STONTestMap.$(C) STONTestMap.$(H): STONTestMap.st $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Dictionary.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\Set.$(H) $(STCHDR)
+$(OUTDIR)STONTestUser.$(O) STONTestUser.$(C) STONTestUser.$(H): STONTestUser.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONTests.$(O) STONTests.$(C) STONTests.$(H): STONTests.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONWriteReadTests.$(O) STONWriteReadTests.$(C) STONWriteReadTests.$(H): STONWriteReadTests.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONWriterTests.$(O) STONWriterTests.$(C) STONWriterTests.$(H): STONWriterTests.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)stx_goodies_ston_tests.$(O) stx_goodies_ston_tests.$(C) stx_goodies_ston_tests.$(H): stx_goodies_ston_tests.st $(INCLUDE_TOP)\stx\libbasic\LibraryDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProjectDefinition.$(H) $(STCHDR)
+$(OUTDIR)STONLargeWriteReadTests.$(O) STONLargeWriteReadTests.$(C) STONLargeWriteReadTests.$(H): STONLargeWriteReadTests.st $(INCLUDE_TOP)\stx\goodies\ston\tests\STONWriteReadTests.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONTestUser2.$(O) STONTestUser2.$(C) STONTestUser2.$(H): STONTestUser2.st $(INCLUDE_TOP)\stx\goodies\ston\tests\STONTestUser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONTestUser3.$(O) STONTestUser3.$(C) STONTestUser3.$(H): STONTestUser3.st $(INCLUDE_TOP)\stx\goodies\ston\tests\STONTestUser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONWriteAsciiOnlyReadTests.$(O) STONWriteAsciiOnlyReadTests.$(C) STONWriteAsciiOnlyReadTests.$(H): STONWriteAsciiOnlyReadTests.st $(INCLUDE_TOP)\stx\goodies\ston\tests\STONWriteReadTests.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONWritePrettyPrinterReadTests.$(O) STONWritePrettyPrinterReadTests.$(C) STONWritePrettyPrinterReadTests.$(H): STONWritePrettyPrinterReadTests.st $(INCLUDE_TOP)\stx\goodies\ston\tests\STONWriteReadTests.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)STONWriteReadCommentsTests.$(O) STONWriteReadCommentsTests.$(C) STONWriteReadCommentsTests.$(H): STONWriteReadCommentsTests.st $(INCLUDE_TOP)\stx\goodies\ston\tests\STONWriteReadTests.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+
+# ENDMAKEDEPEND --- do not remove this line
+
+# **Must be at end**
+
+# Enforce recompilation of package definition class if Mercurial working
+# copy state changes. Together with --guessVersion it ensures that package
+# definition class always contains correct binary revision string.
+!IFDEF HGROOT
+$(OUTDIR)stx_goodies_ston_tests.$(O): $(HGROOT)\.hg\dirstate
+!ENDIF
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/bmake.bat Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,15 @@
+@REM -------
+@REM make using Borland bcc32
+@REM type bmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
+make.exe -N -f bc.mak %DEFINES% %*
+
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/libInit.cc Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,72 @@
+/*
+ * $Header$
+ *
+ * DO NOT EDIT
+ * automagically generated from the projectDefinition: stx_goodies_ston_tests.
+ */
+#define __INDIRECTVMINITCALLS__
+#include <stc.h>
+
+#ifdef WIN32
+# pragma codeseg INITCODE "INITCODE"
+#endif
+
+#if defined(INIT_TEXT_SECTION) || defined(DLL_EXPORT)
+DLL_EXPORT void _libstx_goodies_ston_tests_Init() INIT_TEXT_SECTION;
+DLL_EXPORT void _libstx_goodies_ston_tests_InitDefinition() INIT_TEXT_SECTION;
+#endif
+
+extern void _STONCStyleCommentsSkipStreamTests_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONJSONTests_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONReaderTests_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONTestAssociation_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONTestDomainObject_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONTestKnownObject_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONTestMap_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONTestUser_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONTests_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONWriteReadTests_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONWriterTests_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _stx_137goodies_137ston_137tests_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONLargeWriteReadTests_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONTestUser2_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONTestUser3_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONWriteAsciiOnlyReadTests_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONWritePrettyPrinterReadTests_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _STONWriteReadCommentsTests_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+
+
+
+void _libstx_goodies_ston_tests_InitDefinition(int pass, struct __vmData__ *__pRT__, OBJ snd)
+{
+ __BEGIN_PACKAGE2__("libstx_goodies_ston_tests__DFN", _libstx_goodies_ston_tests_InitDefinition, "stx:goodies/ston/tests");
+ _stx_137goodies_137ston_137tests_Init(pass,__pRT__,snd);
+
+ __END_PACKAGE__();
+}
+
+void _libstx_goodies_ston_tests_Init(int pass, struct __vmData__ *__pRT__, OBJ snd)
+{
+ __BEGIN_PACKAGE2__("libstx_goodies_ston_tests", _libstx_goodies_ston_tests_Init, "stx:goodies/ston/tests");
+ _STONCStyleCommentsSkipStreamTests_Init(pass,__pRT__,snd);
+ _STONJSONTests_Init(pass,__pRT__,snd);
+ _STONReaderTests_Init(pass,__pRT__,snd);
+ _STONTestAssociation_Init(pass,__pRT__,snd);
+ _STONTestDomainObject_Init(pass,__pRT__,snd);
+ _STONTestKnownObject_Init(pass,__pRT__,snd);
+ _STONTestMap_Init(pass,__pRT__,snd);
+ _STONTestUser_Init(pass,__pRT__,snd);
+ _STONTests_Init(pass,__pRT__,snd);
+ _STONWriteReadTests_Init(pass,__pRT__,snd);
+ _STONWriterTests_Init(pass,__pRT__,snd);
+ _stx_137goodies_137ston_137tests_Init(pass,__pRT__,snd);
+ _STONLargeWriteReadTests_Init(pass,__pRT__,snd);
+ _STONTestUser2_Init(pass,__pRT__,snd);
+ _STONTestUser3_Init(pass,__pRT__,snd);
+ _STONWriteAsciiOnlyReadTests_Init(pass,__pRT__,snd);
+ _STONWritePrettyPrinterReadTests_Init(pass,__pRT__,snd);
+ _STONWriteReadCommentsTests_Init(pass,__pRT__,snd);
+
+
+ __END_PACKAGE__();
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/mingwmake.bat Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,18 @@
+@REM -------
+@REM make using mingw gnu compiler
+@REM type mingwmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
+@pushd ..\..\..\rules
+@call find_mingw.bat
+@popd
+make.exe -N -f bc.mak %DEFINES% %USEMINGW_ARG% %*
+
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/stx_goodies_ston_tests.st Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,148 @@
+"{ Package: 'stx:goodies/ston/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+LibraryDefinition subclass:#stx_goodies_ston_tests
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'* Projects & Packages *'
+!
+
+
+!stx_goodies_ston_tests class methodsFor:'description'!
+
+excludedFromPreRequisites
+ "obsolete; temporarily, this is still called for, but will eventually vanish.
+
+ List packages which are to be explicitely excluded from the automatic constructed
+ prerequisites lists (both).
+ If empty, everything that is found along the inheritance of any of
+ my classes is considered to be a prerequisite package."
+
+ ^ #(
+ )
+!
+
+mandatoryPreRequisites
+ "list packages which are mandatory as a prerequisite.
+ This are packages containing superclasses of my classes and classes which
+ are extended by myself.
+ They are mandatory, because we need these packages as a prerequisite for loading and compiling.
+ This method is generated automatically,
+ by searching along the inheritance chain of all of my classes.
+ Please take a look at the #referencedPreRequisites method as well."
+
+ ^ #(
+ #'stx:goodies/sunit' "TestAsserter - superclass of STONCStyleCommentsSkipStreamTests"
+ #'stx:libbasic' "Association - superclass of STONTestAssociation"
+ )
+!
+
+referencedPreRequisites
+ "list packages which are a prerequisite, because they contain
+ classes which are referenced by my classes.
+ These packages are NOT needed as a prerequisite for compiling or loading,
+ however, a class from it may be referenced during execution and having it
+ unloaded then may lead to a runtime doesNotUnderstand error, unless the caller
+ includes explicit checks for the package being present.
+ This method is generated automatically,
+ by searching all classes (and their packages) which are referenced by my classes.
+ Please also take a look at the #mandatoryPreRequisites method"
+
+ ^ #(
+ #'stx:goodies/ston' "STON - referenced by STONCStyleCommentsSkipStreamTests>>testSTON"
+ #'stx:libbasic2' "IdentityBag - referenced by STONWriteReadTests>>testIdentityCollections"
+ #'stx:libview' "Color - referenced by STONReaderTests>>testColor"
+ )
+!
+
+subProjects
+ "list packages which are known as subprojects.
+ The generated makefile will enter those and make there as well.
+ However: they are not forced to be loaded when a package is loaded;
+ for those, redefine #referencedPrerequisites or #mandatoryPreRequisites."
+
+ ^ #(
+ )
+! !
+
+!stx_goodies_ston_tests class methodsFor:'description - contents'!
+
+classNamesAndAttributes
+ "lists the classes which are to be included in the project.
+ Each entry in the list may be: a single class-name (symbol),
+ or an array-literal consisting of class name and attributes.
+ Attributes are: #autoload or #<os> where os is one of win32, unix,..."
+
+ ^ #(
+ "<className> or (<className> attributes...) in load order"
+ STONCStyleCommentsSkipStreamTests
+ STONJSONTests
+ STONReaderTests
+ STONTestAssociation
+ STONTestDomainObject
+ STONTestKnownObject
+ STONTestMap
+ STONTestUser
+ STONTests
+ STONWriteReadTests
+ STONWriterTests
+ #'stx_goodies_ston_tests'
+ STONLargeWriteReadTests
+ STONTestUser2
+ STONTestUser3
+ STONWriteAsciiOnlyReadTests
+ STONWritePrettyPrinterReadTests
+ STONWriteReadCommentsTests
+ )
+!
+
+extensionMethodNames
+ "lists the extension methods which are to be included in the project.
+ Entries are 2-element array literals, consisting of class-name and selector.
+ A correponding method with real names must be present in my concrete subclasses
+ if it has extensions."
+
+ ^ #(
+ )
+! !
+
+!stx_goodies_ston_tests class methodsFor:'description - project information'!
+
+companyName
+ "Returns a company string which will appear in <lib>.rc.
+ Under win32, this is placed into the dll's file-info.
+ Other systems may put it elsewhere, or ignore it."
+
+ ^ 'Claus Gittinger & eXept Software AG'
+!
+
+description
+ "Returns a description string which will appear in nt.def / bc.def"
+
+ ^ 'Smalltalk/X Class library'
+!
+
+legalCopyright
+ "Returns a copyright string which will appear in <lib>.rc.
+ Under win32, this is placed into the dll's file-info.
+ Other systems may put it elsewhere, or ignore it."
+
+ ^ 'Copyright Claus Gittinger 2019\nCopyright eXept Software AG 2019'
+!
+
+productName
+ "Returns a product name which will appear in <lib>.rc.
+ Under win32, this is placed into the dll's file-info.
+ This method is usually redefined in a concrete application definition"
+
+ ^ 'Smalltalk/X'
+! !
+
+!stx_goodies_ston_tests class methodsFor:'documentation'!
+
+version_HG
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/stx_goodies_ston_testsWINrc.rc Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,37 @@
+//
+// DO NOT EDIT
+// automagically generated from the projectDefinition: stx_goodies_ston_tests.
+//
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION 8,0,32767,32767
+ PRODUCTVERSION 8,0,99,0
+#if (__BORLANDC__)
+ FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
+ FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
+ FILEOS VOS_NT_WINDOWS32
+ FILETYPE VFT_DLL
+ FILESUBTYPE VS_USER_DEFINED
+#endif
+
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904E4"
+ BEGIN
+ VALUE "CompanyName", "Claus Gittinger & eXept Software AG\0"
+ VALUE "FileDescription", "Smalltalk/X Class library (LIB)\0"
+ VALUE "FileVersion", "8.0.32767.32767\0"
+ VALUE "InternalName", "stx:goodies/ston/tests\0"
+ VALUE "LegalCopyright", "Copyright Claus Gittinger 2019\nCopyright eXept Software AG 2019\0"
+ VALUE "ProductName", "Smalltalk/X\0"
+ VALUE "ProductVersion", "8.0.99.0\0"
+ VALUE "ProductDate", "Tue, 04 Jun 2019 11:32:52 GMT\0"
+ END
+
+ END
+
+ BLOCK "VarFileInfo"
+ BEGIN // Language | Translation
+ VALUE "Translation", 0x409, 0x4E4 // U.S. English, Windows Multilingual
+ END
+END
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/vcmake.bat Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,22 @@
+@REM -------
+@REM make using Microsoft Visual C compiler
+@REM type vcmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+
+@if not defined VSINSTALLDIR (
+ pushd ..\..\..\rules
+ call vcsetup.bat
+ popd
+)
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
+
+make.exe -N -f bc.mak -DUSEVC=1 %DEFINES% %*
+
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/vcmake.bat Tue Jun 04 12:33:53 2019 +0100
@@ -0,0 +1,22 @@
+@REM -------
+@REM make using Microsoft Visual C compiler
+@REM type vcmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+
+@if not defined VSINSTALLDIR (
+ pushd ..\..\rules
+ call vcsetup.bat
+ popd
+)
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
+
+make.exe -N -f bc.mak -DUSEVC=1 %DEFINES% %*
+
+
+
+