"{ Package: 'stx:goodies/regression' }"

"{ NameSpace: RegressionTests }"

VMCrashTestCase subclass:#VMCrashTests

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'tests-Regression-RuntimeSystem'

!

!VMCrashTests methodsFor:'tests - GC'!

iter_java_initialize

    <spawn: true>

    1 to: 100 do:[:i |

	Stdout nextPutLine: 'Pass '  , i printString.

	Java release: JavaRelease JDK7.

	Java initialize.

	JavaVM initializeVM.

	Java flushAllJavaResources.

	Stdout nextPutLine: 'Full GC...'.

	Smalltalk garbageCollect.

	Stdout nextPutLine: 'Pass '  , i printString , '...OK'.

    ].

    "Created: / 08-09-2014 / 12:33:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_issue_171_crash_in_Smalltalk_keys

    <timeout: 120> "2min"

    <spawn: true>

    "

    Commit a68e1e09f73a/stx:libbasic caused following code to crash the VM.

    "

    Smalltalk keys.

    "Created: / 09-08-2017 / 10:00:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_issue_64_vm_crashes_in_fclose

    "

    Quickly opening and closing files for long enough used to kill the

    VM.

    This testcase keeps opening and closing files for 10 minutes. Just a

    stress-test.

    "

    <spawn: true>

    <timeout: 660> "11min"

    | timeout deadline iterStart iterStop directory files oldSpaceSizeLimit i |

    "/ See https://swing.fit.cvut.cz/projects/stx-jv/ticket/64

    self skipIf: OperatingSystem isMSWINDOWSlike description: 'Temporarily skipped because of issue #64'.

    timeout := self timeout.

    deadline := OperatingSystem getMillisecondTime + ((timeout - 60"extra min to cover variance") * 1000).

    iterStart := iterStop := 0.

    i := 0.

    directory := Smalltalk getPackageDirectoryForPackage: #'stx:goodies'.

    oldSpaceSizeLimit := ObjectMemory oldSpaceUsed + (128"MB"*1024*1024).

    [ OperatingSystem getMillisecondTime < (deadline - (iterStop - iterStart)) ] whileTrue:[

	iterStart := OperatingSystem getMillisecondTime.

	i := i + 1.

	Stdout nextPutLine: 'Pass '  , i printString.

	files := directory recursiveDirectoryContentsAsFilenames select:[:each | each isRegularFile ].

	files := files select: [ :e | e suffix = 'st' ].

	files collect:[ :e | (FileStream fileNamed: e) contents asString ].

	Stdout nextPutLine: 'Pass '  , i printString , '...OK'.

	(oldSpaceSizeLimit notNil and:[ ObjectMemory oldSpaceUsed > oldSpaceSizeLimit ]) ifTrue:[

	    Stdout nextPutLine: 'GC'.

	    files := nil.

	    ObjectMemory compressingGarbageCollect.

	    oldSpaceSizeLimit := ObjectMemory oldSpaceUsed + (128"MB"*1024*1024).

	    Stdout nextPutLine: 'GC...OK '.

	].

	iterStop := OperatingSystem getMillisecondTime.

    ].

    "Created: / 04-09-2016 / 03:16:19 / jv"

    "Modified: / 27-02-2017 / 12:10:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_java_initialize

    "

    Running `JavaVM boot` for long enough used to kill the

    VM due to problems in memory managements.

    This testcase runs for 10 minutes a test in separate VM

    that 100 times boots and flushes the VM.

    "

    <spawn: false>

    <timeout: 660> "11min"

    | timeout deadline iterStart iterStop |

    timeout := self timeout.

    deadline := OperatingSystem getMillisecondTime + ((timeout - 60"extra min to cover variance") * 1000).

    iterStart := iterStop := 0.

    [ OperatingSystem getMillisecondTime < (deadline - (iterStop - iterStart)) ] whileTrue:[

	iterStart := OperatingSystem getMillisecondTime.

	(self class selector: #iter_java_initialize) runCase.

	iterStop := OperatingSystem getMillisecondTime.

    ].

    "Created: / 08-09-2014 / 12:14:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_newspace_overflow

    <timeout: 120> "2min"

    <spawn: true>

    | newSize newLimit |

    newSize := ObjectMemory newSpaceSize.

    newLimit := (newSize * 0.9) rounded.

    "/ Allocate some garbage to fill in new space...

    [ ObjectMemory newSpaceUsed < newLimit ] whileTrue:[

	| a |

	a := Array new: 100.

    ].

    "/ Now, allocate some really huge object

    [

	String new: 300 * 1024 * 1024"300MB"

    ] on: AllocationFailure do:[:ex |

	"/ Do nothing, allocation failure is valid error

    ].

    "Created: / 05-09-2014 / 19:44:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 16-09-2014 / 18:50:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 24-06-2016 / 00:41:29 / jv"

!

test_newspace_resize

    <timeout: 120> "2min"

    <spawn: true>

    | newSize newLimit holder |

    newSize := ObjectMemory newSpaceSize.

    [

    ObjectMemory scavenge.

    newLimit := (ObjectMemory newSpaceSize * 0.9) rounded.

    "/ Fill in new space so it's 90% full, no garbage.

    holder := OrderedCollection new.

    [ ObjectMemory newSpaceUsed < newLimit ] whileTrue:[

	holder add: (Array new: 100).

    ].

    "/ Grow the new space to two times the current size.

    ObjectMemory newSpaceSize: 2 * newSize.

    self assert: (ObjectMemory newSpaceSize >= (2 * newSize)).

    self assert: (ObjectMemory newSpaceUsed / ObjectMemory newSpaceSize) < 0.5.

    "/ Fill in new space so it's 90% full, no garbage.

    newLimit := (ObjectMemory newSpaceSize * 0.9) rounded.

    [ ObjectMemory newSpaceUsed < newLimit ] whileTrue:[

	holder add: (Array new: 100).

    ].

    "/ Increase old space to make sure there's enough

    "/ old space to tenure objects to. See

    "/

    "/ ObjectMemory >> newSpaceSize:

    "/

    ObjectMemory moreOldSpace: newSize * 2.

    ObjectMemory newSpaceSize: newSize.

    self assert: (ObjectMemory newSpaceSize < (newSize + 4096"page size as tolerance for page aligning")).

    ] ensure:[

	ObjectMemory newSpaceSize: newSize.

    ].

    "Created: / 21-09-2017 / 23:16:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 05-10-2017 / 22:28:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 08-10-2017 / 23:51:30 / jv"

!

test_stx_libjava_testSuite_inspect

    <timeout: 120> "2min"

    <spawn: true>

    stx_libjava testSuite inspect.

    "Created: / 01-05-2017 / 21:34:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!VMCrashTests class methodsFor:'documentation'!

version

    ^ '$Header$'

!

version_CVS

    ^ '$Header$'

!

version_HG

    ^ '$Changeset: <not expanded> $'

! !