"{ 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_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_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> $'
! !