;; cannotReturn: tests — escape past a returned-from method must error.
;;
;; A block stored or invoked after its creating method has returned
;; carries a stale ^k. Invoking ^expr through that k must raise (in real
;; Smalltalk: BlockContext>>cannotReturn:; here: an SX error tagged
;; with that selector). A normal value-returning block (no ^) is fine.

(set! st-test-pass 0)
(set! st-test-fail 0)
(set! st-test-fails (list))

(st-bootstrap-classes!)
(define ev (fn (src) (smalltalk-eval src)))
(define evp (fn (src) (smalltalk-eval-program src)))

;; helper: substring check on actual SX strings
(define
  str-contains?
  (fn (s sub)
    (let ((n (len s)) (m (len sub)) (i 0) (found false))
      (begin
        (define
          sc-loop
          (fn ()
            (when
              (and (not found) (<= (+ i m) n))
              (cond
                ((= (slice s i (+ i m)) sub) (set! found true))
                (else (begin (set! i (+ i 1)) (sc-loop)))))))
        (sc-loop)
        found))))

;; ── 1. Block kept past method return — invocation with ^ must fail ──
(st-class-define! "BlockBox" "Object" (list "block"))
(st-class-add-method! "BlockBox" "block:"
  (st-parse-method "block: aBlock block := aBlock. ^ self"))
(st-class-add-method! "BlockBox" "block"
  (st-parse-method "block ^ block"))

;; A method whose return-value is a block that does ^ inside.
;; Once `escapingBlock` returns, its ^k is dead.
(st-class-define! "Trapper" "Object" (list))
(st-class-add-method! "Trapper" "stash"
  (st-parse-method "stash | b | b := [^ #shouldNeverHappen]. ^ b"))

(define stale-block-test
  (guard
    (c (true {:caught true :msg (str c)}))
    (let ((b (evp "^ Trapper new stash")))
      (begin
        (st-block-apply b (list))
        {:caught false :msg nil}))))

(st-test
  "invoking ^block from a returned method raises"
  (get stale-block-test :caught)
  true)

(st-test
  "error message mentions cannotReturn:"
  (let ((m (get stale-block-test :msg)))
    (or
      (and (string? m) (> (len m) 0) (str-contains? m "cannotReturn"))
      false))
  true)

;; ── 2. A normal (non-^) block survives just fine across methods ──
(st-class-add-method! "Trapper" "stashAdder"
  (st-parse-method "stashAdder ^ [:x | x + 100]"))

(st-test
  "non-^ block keeps working after creating method returns"
  (let ((b (evp "^ Trapper new stashAdder")))
    (st-block-apply b (list 5)))
  105)

;; ── 3. Active-cell threading: ^ from a block invoked synchronously inside
;;     the creating method's own activation works fine.
(st-class-add-method! "Trapper" "syncFlow"
  (st-parse-method "syncFlow #(1 2 3) do: [:e | e = 2 ifTrue: [^ #foundTwo]]. ^ #notFound"))
(st-test "synchronous ^ from block still works"
  (str (evp "^ Trapper new syncFlow"))
  "foundTwo")

;; ── 4. Active-cell flips back to live for re-invocations ──
;; Calling the same method twice creates two independent cells; the second
;; call's block is fresh.
(st-class-add-method! "Trapper" "secondOK"
  (st-parse-method "secondOK ^ #ok"))
(st-test "method called twice in sequence still works"
  (let ((a (evp "^ Trapper new secondOK"))
        (b (evp "^ Trapper new secondOK")))
    (str (str a b)))
  "okok")

(list st-test-pass st-test-fail)
