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

"{ NameSpace: RegressionTests }"

VMCrashTestCase subclass:#VMCrashTests
	instanceVariableNames:'x y'
	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_182_crash_when_java_is_flushed
    <timeout: 300> "300min"
    <spawn: true>

    "
    If some code is still running when Java is flushed the
    VM crashed.
    "

    | blocker iters |

    Smalltalk loadPackage:'stx:libjava/tests'.

    blocker := Semaphore new.
    JavaVM reboot.

    [
        [
            | issue182 |

            issue182 := JAVA stx libjava tests mocks Issue182 new.
            issue182 loopFor: 15.
        ] on: JavaClassFormatError do:[
            "/ This is expected
        ] on: Error do:[:ex |
            ex suspendedContext fullPrintAllOn: Stdout.
        ].
        blocker signal.
    ] fork.
    Delay waitForSeconds: 5.
    JAVA stx libjava tests mocks Issue182 constantPool atAllPut: nil.
    blocker wait.

    "Created: / 19-10-2017 / 19:55:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 26-10-2017 / 11:51:35 / 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>

    (Smalltalk at:#stx_libjava) testSuite inspect.

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

!VMCrashTests methodsFor:'tests - context'!

callResend1
    x == 1 ifTrue:[
        x := 2.
        thisContext resend.
        ^ self.
    ].
    x == 2 ifTrue:[
        x := 3.
        y := thisContext.
        thisContext unwindThenDo:[ AbortOperationRequest raise ]
    ].
    self assert:false.

    "Created: / 17-11-2017 / 13:59:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

callUnwindThenRestart1
    x == 1 ifTrue:[
        x := 2.
        thisContext unwindAndRestart.
    ] ifFalse:[
        x := 3.
    ].

    "Created: / 14-11-2017 / 20:58:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

callUnwindThenRestart2a
    [
        self callUnwindThenRestart2b
    ] ensure:[
        y := 10
    ].

    "Created: / 14-11-2017 / 21:10:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

callUnwindThenRestart2b
    x == 1 ifTrue:[
        x := 2.
        thisContext sender sender unwindAndRestart.
    ] ifFalse:[
        x := 3.
    ].

    "Created: / 14-11-2017 / 21:10:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

callUnwindThenRestart3
    x == 1 ifTrue:[
        x := 2.
        thisContext unwindAndRestart.
        ^ self.
    ].
    x == 2 ifTrue:[
        x := 3.
        thisContext unwindThenDo:[  AbortOperationRequest raise  ]
    ].
    self assert: false.

    "Created: / 14-11-2017 / 21:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testResend1
    <spawn: true>

    | aborted |

    x := 1.
    y := 1.
    aborted := false.
    [
        self callResend1.
    ] on:AbortOperationRequest do:[:ex | aborted := true. ].
    self assert:aborted.
    self assert:x == 3.
    self assert:y method == (self class >> #callResend1)

    "
     VMCrashTests new testResend1
    "

    "Created: / 17-11-2017 / 13:58:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 17-11-2017 / 15:17:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testUnwindThenRestart1
    <spawn: true>

    x := 1.
    y := 1.
    self callUnwindThenRestart1.
    self assert: x == 3.
    self assert: y == 1.

    "
    VMCrashTests new testUnwindThenRestart1
    "

    "Created: / 14-11-2017 / 20:58:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testUnwindThenRestart2
    <spawn: true>

    x := 1.
    y := 1.
    self callUnwindThenRestart2a.
    self assert: x == 3.
    self assert: y == 10.

    "
    VMCrashTests new testUnwindThenRestart1
    "

    "Created: / 14-11-2017 / 21:09:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testUnwindThenRestart3
    | aborted |

    <spawn: true>

    x := 1.
    y := 1.
    aborted := false.
    [
        self callUnwindThenRestart3.
    ] on: AbortOperationRequest do:[:ex |
        aborted := true.
    ].
    self assert: aborted.
    self assert: x == 3.
    self assert: y == 1.

    "
    VMCrashTests new testUnwindThenRestart3
    "

    "Created: / 14-11-2017 / 21:20:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 17-11-2017 / 13:56:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VMCrashTests methodsFor:'tests - misc'!

endlessB
    | b |

    b := [ b value ].
    b value

    "Created: / 18-12-2017 / 09:32:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

endlessB:a1
    | b |

    b := [:x1 | b value:x1 ].
    b value:a1

    "Created: / 18-12-2017 / 21:03:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

endlessB:a1 _:a2
    | b |

    b := [ :x1 :x2 | b value:x1 value:x2].
    b value:a1 value:a2

    "Created: / 18-12-2017 / 21:03:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

endlessB:a1 _:a2 _:a3
    | b |

    b := [ :x1 :x2 :x3 |b value:x1 value:x2 value:x3].
    b value:a1 value:a2 value:a3

    "Created: / 18-12-2017 / 21:03:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

endlessM
    self endlessM

    "Created: / 18-12-2017 / 09:31:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_issue_186b0_c
    "
     https://swing.fit.cvut.cz/projects/stx-jv/ticket/186
    "
    <spawn: true>

    ObjectMemory justInTimeCompilation:false.
    ParserFlags withSTCCompilation:#always
        do:[ self class recompile:#endlessB ].
    [
        self endlessB.
        self assert:false.
    ] on:RecursionError
            do:[:ex |
        Debugger classResources.
        self assert:true.
    ]

    "Created: / 18-12-2017 / 09:34:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (format): / 18-12-2017 / 21:07:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_issue_186b0_i
    "
     https://swing.fit.cvut.cz/projects/stx-jv/ticket/186"
    <spawn: true>

    ObjectMemory justInTimeCompilation:false.
    [
        self endlessB.
        self assert:false.
    ] on:RecursionError
            do:[:ex |
        Debugger classResources.
        self assert:true.
    ]

    "Created: / 18-12-2017 / 09:28:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (format): / 18-12-2017 / 21:08:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_issue_186b0_j
    "
     https://swing.fit.cvut.cz/projects/stx-jv/ticket/186"
    <spawn: true>


    ObjectMemory justInTimeCompilation:true.
    self skipIf:ObjectMemory justInTimeCompilation not
        description:'JIT not supported by current platform'.
    [
        self endlessB.
        self assert:false.
    ] on:RecursionError
            do:[:ex |
        Debugger classResources.
        self assert:true.
    ]

    "Created: / 18-12-2017 / 09:28:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (format): / 18-12-2017 / 21:08:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_issue_186b1_c
    "
     https://swing.fit.cvut.cz/projects/stx-jv/ticket/186"
    <spawn: true>


    ObjectMemory justInTimeCompilation:false.
    ParserFlags withSTCCompilation:#always
        do:[ self class recompile:#endlessB: ].
    [
        self endlessB: 1.
        self assert:false.
    ] on:RecursionError
            do:[:ex |
        Debugger classResources.
        self assert:true.
    ]

    "Created: / 18-12-2017 / 21:04:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_issue_186b1_i
    "
     https://swing.fit.cvut.cz/projects/stx-jv/ticket/186"
    <spawn: true>


    ObjectMemory justInTimeCompilation:false.
    [
        self endlessB:1.
        self assert:false.
    ] on:RecursionError
            do:[:ex |
        Debugger classResources.
        self assert:true.
    ]

    "Created: / 18-12-2017 / 21:05:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_issue_186b1_j
    "
     https://swing.fit.cvut.cz/projects/stx-jv/ticket/186"
    <spawn: true>


    ObjectMemory justInTimeCompilation:true.
    self skipIf:ObjectMemory justInTimeCompilation not
        description:'JIT not supported by current platform'.
    [
        self endlessB:1.
        self assert:false.
    ] on:RecursionError
            do:[:ex |
        Debugger classResources.
        self assert:true.
    ]

    "Created: / 18-12-2017 / 21:05:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_issue_186b2_c
    "
     https://swing.fit.cvut.cz/projects/stx-jv/ticket/186"
    <spawn: true>

    ObjectMemory justInTimeCompilation:false.
    ParserFlags withSTCCompilation:#always
        do:[ self class recompile:#endlessB:_: ].
    [
        self endlessB: 1 _:2.
        self assert:false.
    ] on:RecursionError
            do:[:ex |
        Debugger classResources.
        self assert:true.
    ]

    "Created: / 18-12-2017 / 21:04:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_issue_186b2_i
    "
     https://swing.fit.cvut.cz/projects/stx-jv/ticket/186"
    <spawn: true>


    ObjectMemory justInTimeCompilation:false.
    [
        self endlessB:1 _:2.
        self assert:false.
    ] on:RecursionError
            do:[:ex |
        Debugger classResources.
        self assert:true.
    ]

    "Created: / 18-12-2017 / 21:05:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_issue_186b2_j
    "
     https://swing.fit.cvut.cz/projects/stx-jv/ticket/186"
    <spawn: true>


    ObjectMemory justInTimeCompilation:true.
    self skipIf:ObjectMemory justInTimeCompilation not
        description:'JIT not supported by current platform'.
    [
        self endlessB:1 _:2.
        self assert:false.
    ] on:RecursionError
            do:[:ex |
        Debugger classResources.
        self assert:true.
    ]

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

test_issue_186b3_c
    "
     https://swing.fit.cvut.cz/projects/stx-jv/ticket/186"
    <spawn: true>


    ObjectMemory justInTimeCompilation:false.
    ParserFlags withSTCCompilation:#always
        do:[ self class recompile:#endlessB:_:_: ].
    [
        self endlessB: 1 _:2 _:3.
        self assert:false.
    ] on:RecursionError
            do:[:ex |
        Debugger classResources.
        self assert:true.
    ]

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

test_issue_186b3_i
    "
     https://swing.fit.cvut.cz/projects/stx-jv/ticket/186"
    <spawn: true>


    ObjectMemory justInTimeCompilation:false.
    [
        self endlessB:1 _:2 _:3.
        self assert:false.
    ] on:RecursionError
            do:[:ex |
        Debugger classResources.
        self assert:true.
    ]

    "Created: / 18-12-2017 / 21:06:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_issue_186b3_j
    "
     https://swing.fit.cvut.cz/projects/stx-jv/ticket/186"
    <spawn: true>


    ObjectMemory justInTimeCompilation:true.
    self skipIf:ObjectMemory justInTimeCompilation not
        description:'JIT not supported by current platform'.
    [
        self endlessB:1 _:2 _:3.
        self assert:false.
    ] on:RecursionError
            do:[:ex |
        Debugger classResources.
        self assert:true.
    ]

    "Created: / 18-12-2017 / 21:05:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_issue_186m_c
    "
    https://swing.fit.cvut.cz/projects/stx-jv/ticket/186
    "
    <spawn: true>

    ObjectMemory justInTimeCompilation: false.
    ParserFlags withSTCCompilation:#always do:[
        self class recompile:#endlessM
    ].
    [
        self endlessM.
        self assert: false.
    ] on: RecursionError do:[:ex |
        Debugger classResources.
        self assert: true.
    ]

    "Created: / 18-12-2017 / 09:34:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_issue_186m_i
    "
    https://swing.fit.cvut.cz/projects/stx-jv/ticket/186
    "
    <spawn: true>

    ObjectMemory justInTimeCompilation: false.

    [
        self endlessM.
        self assert: false.
    ] on: RecursionError do:[:ex |
        Debugger classResources.
        self assert: true.
    ]

    "Created: / 18-12-2017 / 09:26:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_issue_186m_j
    "
    https://swing.fit.cvut.cz/projects/stx-jv/ticket/186
    "
    <spawn: true>

    ObjectMemory justInTimeCompilation: true.
    self skipIf: ObjectMemory justInTimeCompilation not description: 'JIT not supported by current platform'.

    [
        self endlessM.
        self assert: false.
    ] on: RecursionError do:[:ex |
        Debugger classResources.
        self assert: true.
    ]

    "Created: / 18-12-2017 / 09:27:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!VMCrashTests class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
!

version_HG

    ^ '$Changeset: <not expanded> $'
! !