WarnDie.java

package org.perlonjava.runtime.operators;

import org.perlonjava.backend.bytecode.InterpreterState;
import org.perlonjava.backend.jvm.ByteCodeSourceMapper;
import org.perlonjava.runtime.perlmodule.Universal;
import org.perlonjava.runtime.perlmodule.Warnings;
import org.perlonjava.runtime.regex.RuntimeRegex;
import org.perlonjava.runtime.runtimetypes.*;

import java.util.HashMap;

import static org.perlonjava.runtime.runtimetypes.GlobalVariable.*;
import static org.perlonjava.runtime.runtimetypes.RuntimeScalarCache.scalarUndef;
import static org.perlonjava.runtime.runtimetypes.SpecialBlock.runEndBlocks;

/**
 * The WarnDie class provides implementations for the warn, die, and exit operations,
 * which are used to issue warnings and terminate execution with an error message,
 * respectively. These operations can trigger custom signal handlers if defined.
 */
public class WarnDie {
    public static boolean isInsideUnhandledDieHandler() {
        return PerlRuntime.current().executionState().insideUnhandledDieHandler;
    }

    private record SyntheticDieCallerFrame(String packageName, String filename, int line) {
    }

    /**
     * Returns true when a %SIG slot holds one of Perl 5's reserved string
     * values ("DEFAULT" or "IGNORE") rather than a real handler. In that
     * case Perl 5 does NOT invoke any handler when the corresponding event
     * fires; trying to dispatch on the string would otherwise look up a
     * sub by that literal name (e.g. `&main::DEFAULT`) and croak with
     * "Undefined subroutine".
     *
     * Real-world repro: URI::Find::find() does
     *     local $SIG{__DIE__} = 'DEFAULT';
     * and then calls URI->new(...) which internally does
     *     eval "require URI::git";
     * If `URI::git` is missing, the eval-string failure dispatched
     * through this handler tried to call `&main::DEFAULT` and clobbered
     * $@ inside _is_uri, making `git://` and `svn+ssh://` URIs
     * undetectable (URI-Find t/Find.t tests 355, 364).
     */
    private static boolean isReservedSigString(RuntimeScalar sig) {
        if (sig == null || !sig.getDefinedBoolean()) return false;
        // Only treat plain strings as reserved; CODE refs / globs are real handlers.
        if (RuntimeScalarType.isReference(sig)) return false;
        if (sig.type == RuntimeScalarType.CODE) return false;
        if (sig.type == RuntimeScalarType.GLOB || sig.type == RuntimeScalarType.GLOBREFERENCE) return false;
        String s = sig.toString();
        return "DEFAULT".equals(s) || "IGNORE".equals(s);
    }

    private static Throwable unwrapException(Throwable throwable) {
        Throwable current = throwable;

        // Unwrap RuntimeExceptions that just wrap other exceptions
        while (current instanceof RuntimeException && current.getCause() != null) {
            Throwable cause = current.getCause();

            // Stop unwrapping if we find a meaningful exception
            if (cause instanceof PerlDieException pde) {
                return pde;
            }
            if (cause instanceof PerlCompilerException pc) {
                return pc;
            }
            current = cause;
        }
        return throwable;
    }

    private static SyntheticDieCallerFrame firstPerlFrame(Throwable throwable) {
        try {
            ExceptionFormatter.StackTraceResult result = ExceptionFormatter.formatExceptionDetailed(throwable);
            if (result.frames().isEmpty()) {
                return null;
            }
            var frame = result.frames().getFirst();
            if (frame.size() < 3 || frame.get(1) == null || frame.get(1).isEmpty()) {
                return null;
            }
            int line = Integer.parseInt(frame.get(2));
            return new SyntheticDieCallerFrame(frame.get(0), frame.get(1), line);
        } catch (Throwable ignored) {
            return null;
        }
    }

    private static String signalHandlerSubName(RuntimeScalar sigHandler) {
        if (sigHandler == null || sigHandler.type != RuntimeScalarType.CODE
                || !(sigHandler.value instanceof RuntimeCode code)) {
            return null;
        }
        if (code.subName == null || code.subName.isEmpty()) {
            return null;
        }
        if (code.subName.contains("::")) {
            return code.subName;
        }
        String pkg = code.packageName != null && !code.packageName.isEmpty()
                ? code.packageName
                : "main";
        return pkg + "::" + code.subName;
    }

    private static void writeWarningToStderr(String message) {
        RuntimeIO stderrIO = getGlobalIO("main::STDERR").getRuntimeIO();
        if (stderrIO == null) {
            stderrIO = RuntimeIO.getStderr();
        }
        if (stderrIO != null) {
            stderrIO.write(message);
        } else {
            System.err.print(message);
        }
    }

    public static RuntimeException maybeInvokeUnhandledDieHandler(RuntimeException e) {
        Throwable unwrapped = unwrapException(e);
        if (unwrapped instanceof PerlDieException
                || unwrapped instanceof PerlExitException
                || unwrapped instanceof PerlThreadExitException) {
            return e;
        }
        if (RuntimeCode.getEvalDepth() > 0) {
            return e;
        }

        RuntimeScalar sig = getGlobalHash("main::SIG").get("__DIE__");
        if (!sig.getDefinedBoolean() || isReservedSigString(sig)) {
            return e;
        }

        var seen = PerlRuntime.current().executionState().unhandledDieHandlerSeen;
        if (seen.containsKey(unwrapped)) {
            return e;
        }
        seen.put(unwrapped, Boolean.TRUE);

        RuntimeArray args = new RuntimeArray();
        RuntimeArray.push(args, new RuntimeScalar(ErrorMessageUtil.stringifyException(unwrapped)));
        RuntimeScalar sigHandler = new RuntimeScalar(sig);
        SyntheticDieCallerFrame syntheticFrame = firstPerlFrame(unwrapped);
        String handlerSubName = signalHandlerSubName(sigHandler);

        int level = DynamicVariableManager.getLocalLevel();
        DynamicVariableManager.pushLocalVariable(sig);
        ExecutionRuntimeState runtimeState = PerlRuntime.current().executionState();
        boolean wasInsideUnhandledDieHandler = runtimeState.insideUnhandledDieHandler;
        runtimeState.insideUnhandledDieHandler = true;
        boolean pushedSyntheticFrame = false;
        try {
            if (syntheticFrame != null) {
                RuntimeCode.pushSyntheticCallerFrame(
                        syntheticFrame.packageName(),
                        syntheticFrame.filename(),
                        syntheticFrame.line(),
                        handlerSubName);
                pushedSyntheticFrame = true;
            }
            RuntimeCode.apply(sigHandler, args, RuntimeContextType.SCALAR);
        } catch (Throwable handlerException) {
            Throwable handled = unwrapException(handlerException);
            if (handled instanceof RuntimeException re) {
                return re;
            }
            return new RuntimeException(handled);
        } finally {
            if (pushedSyntheticFrame) {
                RuntimeCode.popSyntheticCallerFrame();
            }
            runtimeState.insideUnhandledDieHandler = wasInsideUnhandledDieHandler;
            DynamicVariableManager.popToLocalLevel(level);
        }
        return e;
    }

    /**
     * Catches the exception in an eval-block.
     * Note: PerlExitException should NEVER be caught by eval{} - it always propagates.
     */
    public static RuntimeScalar catchEval(Throwable e) {
        e = unwrapException(e);
        
        // exit() should never be caught by eval{} - re-throw it
        if (e instanceof PerlExitException exit) {
            throw exit;
        }
        if (e instanceof PerlThreadExitException exit) {
            throw exit;
        }

        RuntimeScalar pendingWarning = PerlRuntime.current().executionState()
                .pendingThreadWarningHandler;
        PerlRuntime.current().executionState().pendingThreadWarningHandler = null;
        if (pendingWarning != null) {
            RuntimeScalar.scopeExitCleanup(pendingWarning);
        }
        
        RuntimeScalar err = getGlobalVariable("main::@");

        if (e instanceof PerlDieException pde) {
            RuntimeBase payload = pde.getPayload();
            if (payload != null) {
                err.set(payload.getFirst());
            }
            // die() already invokes $SIG{__DIE__} (when defined). Perl's eval
            // should not invoke it again while catching the exception.
            return scalarUndef;
        } else {
            err.set(new RuntimeScalar(ErrorMessageUtil.stringifyException(e)));
        }

        RuntimeScalar sig = getGlobalHash("main::SIG").get("__DIE__");
        if (sig.getDefinedBoolean() && !isReservedSigString(sig)) {
            RuntimeArray args = new RuntimeArray();
            RuntimeArray.push(args, new RuntimeScalar(err));

            RuntimeScalar sigHandler = new RuntimeScalar(sig);

            // Undefine $SIG{__DIE__} before calling the handler to avoid infinite recursion
            int level = DynamicVariableManager.getLocalLevel();
            DynamicVariableManager.pushLocalVariable(sig);

            // Temporarily restore eval depth so $^S reads 1 inside the handler.
            // By the time we reach catchEval(), evalDepth has already been decremented
            // by the eval catch block, but the handler should see $^S=1 since we are
            // conceptually still inside eval (Perl 5 calls the handler before unwinding).
            RuntimeCode.incrementEvalDepth();
            boolean pushedEvalFrame = InterpreterState.pushEvalFrameForCurrentInterpreter();
            try {
                RuntimeCode.apply(sigHandler, args, RuntimeContextType.SCALAR);
            } catch (Throwable handlerException) {
                // Unwrap RuntimeException to get to the real exception
                handlerException = unwrapException(handlerException);

                // If the handler dies, use its payload as the new error
                if (handlerException instanceof PerlDieException pde) {
                    RuntimeBase handlerPayload = pde.getPayload();
                    if (handlerPayload != null) {
                        err.set(handlerPayload.getFirst());
                    }
                } else {
                    // If the handler throws any other exception, stringify it
                    err.set(new RuntimeScalar(ErrorMessageUtil.stringifyException(handlerException)));
                }
            } finally {
                if (pushedEvalFrame) {
                    InterpreterState.pop();
                }
                RuntimeCode.decrementEvalDepth();
                // Restore $SIG{__DIE__}
                DynamicVariableManager.popToLocalLevel(level);
            }
        }
        return scalarUndef;
    }

    /**
     * Issues a warning message. If a custom warning handler is defined in the
     * global %SIG hash under the "__WARN__" key, it will be invoked with the
     * warning message. Otherwise, the message is printed to standard error.
     *
     * @param message The warning message to be issued.
     * @param where   Additional context or location information to append to the message.
     * @return A RuntimeBase representing the result of the warning operation.
     */
    public static RuntimeBase warn(RuntimeBase message, RuntimeScalar where) {
        return warn(message, where, null, 0);
    }

    public static RuntimeBase warn(RuntimeBase message, RuntimeScalar where, String fileName, int lineNumber) {
        RuntimeScalar sig = getGlobalHash("main::SIG").get("__WARN__");

        // If message is empty or just whitespace, handle special cases
        String messageStr = message.toString();
        RuntimeScalar finalMessage;

        if (messageStr.isEmpty()) {
            RuntimeScalar err = getGlobalVariable("main::@");
            // Resolve tied $@ once to avoid double FETCH (Perl 5 fetches $@ exactly once)
            if (err.type == RuntimeScalarType.TIED_SCALAR) {
                err = err.tiedFetch();
            }
            if (RuntimeScalarType.isReference(err)) {
                // If $@ is a reference, pass it directly to the signal handler
                finalMessage = new RuntimeScalar(err);
            } else if (err.getDefinedBoolean() && !err.toString().isEmpty()) {
                // String in $@, append "...caught" with location. If $@ has no
                // trailing newline, Perl appends directly after the message.
                String errStr = err.toString();
                String caught = errStr.endsWith("\n") ? "\t...caught" : "\t...caught";
                String out = errStr + caught + where;
                if (!out.endsWith("\n")) {
                    out += ".\n";
                }
                finalMessage = new RuntimeScalar(out);
            } else {
                finalMessage = new RuntimeScalar("Warning: something's wrong" + where.toString());
                if (!finalMessage.toString().endsWith("\n")) {
                    finalMessage.set(finalMessage + ".\n");
                }
            }
        } else {
            // Handle non-empty message
            if (RuntimeScalarType.isReference(message.getFirst())) {
                // Message is a reference, pass it as-is
                finalMessage = new RuntimeScalar(message.getFirst());
            } else {
                // String message
                String out = messageStr;
                if (!out.endsWith("\n")) {
                    String whereStr = where.toString();
                    // If no explicit location provided, derive from Perl call stack
                    if (whereStr.isEmpty() && (fileName == null || fileName.isEmpty())) {
                        whereStr = getPerlLocationFromStack();
                    }
                    out += whereStr;
                    // Add period and newline if location info was added
                    if (!whereStr.isEmpty()) {
                        out += ".\n";
                    } else if (!out.endsWith("\n")) {
                        out += "\n";
                    }
                }
                finalMessage = new RuntimeScalar(out);
            }
        }

        if (sig.getDefinedBoolean() && !isReservedSigString(sig)) {
            RuntimeArray args = new RuntimeArray();
            RuntimeArray.push(args, finalMessage);

            RuntimeScalar sigHandler = new RuntimeScalar(sig);

            // Undefine $SIG{__WARN__} before calling the handler to avoid infinite recursion
            int level = DynamicVariableManager.getLocalLevel();
            DynamicVariableManager.pushLocalVariable(sig);

            RuntimeList res = RuntimeCode.apply(sigHandler, args, RuntimeContextType.SCALAR);

            // Handle TAILCALL with trampoline loop (for goto &sub in __WARN__ handlers)
            while (res.isNonLocalGoto()) {
                RuntimeControlFlowList flow = (RuntimeControlFlowList) res;
                if (flow.getControlFlowType() == ControlFlowType.TAILCALL) {
                    RuntimeScalar codeRef = flow.getTailCallCodeRef();
                    RuntimeArray callArgs = flow.getTailCallArgs();
                    res = RuntimeCode.apply(codeRef, "tailcall", callArgs, RuntimeContextType.SCALAR);
                } else {
                    break;
                }
            }

            // Restore $SIG{__WARN__}
            DynamicVariableManager.popToLocalLevel(level);

            return new RuntimeScalar(1);  // Perl's warn() always returns 1
        }

        // $SIG{__WARN__} = 'IGNORE' suppresses the warning entirely; 'DEFAULT'
        // (and the unset case) falls through to writing on STDERR.
        if (sig.getDefinedBoolean() && "IGNORE".equals(sig.toString())
                && !RuntimeScalarType.isReference(sig)
                && sig.type != RuntimeScalarType.CODE
                && sig.type != RuntimeScalarType.GLOB
                && sig.type != RuntimeScalarType.GLOBREFERENCE) {
            return new RuntimeScalar(1);
        }

        writeWarningToStderr(finalMessage.toString());

        return new RuntimeScalar(1);  // Perl's warn() always returns 1
    }

    /**
     * Issues a warning message with category checking.
     * - If the warning category is not enabled in the caller's scope, suppresses the warning.
     * - If the warning category is suppressed at runtime (via "no warnings"), suppresses it.
     * - If the warning category is FATAL in the caller's scope, throws an exception instead.
     *
     * @param message  The warning message to be issued.
     * @param where    Additional context or location information.
     * @param category The warning category (e.g., "uninitialized", "numeric").
     * @return A RuntimeBase representing the result of the warning operation.
     */
    public static RuntimeBase warnWithCategory(RuntimeBase message, RuntimeScalar where, String category) {
        return warnWithCategory(message, where, category, null, 0);
    }

    public static RuntimeBase warnWithCategory(RuntimeBase message, RuntimeScalar where, String category,
                                                String fileName, int lineNumber) {
        if (WarningFlags.areWarningsForcedOff()) {
            return new RuntimeScalar();
        }
        // Perl-core helpers use `local $^W = 0` to suppress warnings while
        // deliberately probing numeric/string behavior. That dynamic override
        // takes precedence over an interpreter caller's lexical warning bits.
        if (Warnings.isWarnFlagLocalized() && !Warnings.isWarnFlagSet()) {
            return new RuntimeScalar();
        }

        // Get the warning bits for the current Perl execution context.
        // We scan the Java call stack for the nearest Perl frame (org.perlonjava.anon* or perlmodule)
        // and look up its warning bits in WarningBitsRegistry.
        // NOTE: We do NOT use getCallSiteBits() here because it is a ThreadLocal that
        // persists across function calls and would leak the caller's warning scope into
        // the callee (e.g., pack.t's "use warnings" would leak into test.pl's skip()
        // function even with "local $^W = 0"). callSiteBits is only for caller()[9].
        String warningBits = org.perlonjava.runtime.WarningBitsRegistry.getRuntimeWarningBits();
        if (warningBits == null) {
            warningBits = getWarningBitsFromCurrentContext();
        }
        
        // If no bits from direct stack scan, check the current context stack (pushed on sub entry)
        if (warningBits == null) {
            warningBits = org.perlonjava.runtime.WarningBitsRegistry.getCurrent();
        }
        // If warning bits are available, check if this category is enabled
        if (WarningFlags.areWarningsForcedOn()) {
            if (warningBits != null && WarningFlags.isFatalInBits(warningBits, category)) {
                return die(message, where, fileName, lineNumber);
            }
        } else if (warningBits != null) {
            if (WarningFlags.isEnabledInBits(warningBits, category)) {
                // Category is lexically enabled - check for FATAL
                if (WarningFlags.isFatalInBits(warningBits, category)) {
                    return die(message, where, fileName, lineNumber);
                }
                // Fall through to emit warning
            } else if (!Warnings.isWarnFlagSet()) {
                // Category not lexically enabled AND $^W not set - suppress
                return new RuntimeScalar();
            }
            // If $^W is set, fall through to emit warning even if not lexically enabled
        } else {
            // No bits from caller - fall back to $^W global flag
            if (!Warnings.isWarnFlagSet()) {
                return new RuntimeScalar();
            }
        }
        
        // Check if the category is suppressed at runtime via "no warnings" in current scope
        if (WarningFlags.isWarningSuppressedAtRuntime(category)) {
            return new RuntimeScalar();
        }
        
        // Issue as regular warning
        return warn(message, where, fileName, lineNumber);
    }

    /**
     * Gets warning bits by scanning the Java call stack for Perl frames.
     * This looks for org.perlonjava.anon* and perlmodule classes, which are
     * JVM-compiled Perl code, and returns the first found warning bits.
     * This is more reliable than using caller() which may skip frames.
     *
     * @return The warning bits string, or null if not available
     */
    private static String getWarningBitsFromCurrentContext() {
        Throwable t = new Throwable();
        for (StackTraceElement element : t.getStackTrace()) {
            String className = element.getClassName();
            // Only look at compiled Perl frames for warning bits.
            // Skip perlmodule frames (Java-implemented builtins) — they don't
            // have lexical warning scopes; we want the Perl caller's scope.
            if (className.contains("org.perlonjava.anon")) {
                // Found a Perl frame - look up its warning bits
                String bits = org.perlonjava.runtime.WarningBitsRegistry.get(className);
                if (bits != null) {
                    return bits;
                }
            }
        }
        return null;
    }

    /**
     * Gets the Perl source location string (" at FILE line N") from the current
     * execution context. First checks interpreter frames (which don't create
     * org.perlonjava.anon* JVM stack entries), then falls back to scanning the
     * JVM call stack for compiled Perl frames.
     *
     * @return A location string like " at script.pl line 42", or empty string if not found
     */
    static String getPerlLocationFromStack() {
        // Check interpreter state first - interpreter frames don't create
        // org.perlonjava.anon* JVM stack entries, so JVM stack scanning
        // would skip them and find the wrong (calling Java code) location.
        var frame = InterpreterState.current();
        if (frame != null && frame.code() != null) {
            var pcs = InterpreterState.getPcStack();
            if (!pcs.isEmpty()) {
                int currentPc = pcs.getLast();
                if (frame.code().pcToTokenIndex != null && !frame.code().pcToTokenIndex.isEmpty()) {
                    var pcEntry = frame.code().pcToTokenIndex.floorEntry(currentPc);
                    if (pcEntry != null) {
                        int tokenIndex = pcEntry.getValue();
                        if (frame.code().errorUtil != null) {
                            var loc = frame.code().errorUtil.getSourceLocationAccurate(tokenIndex);
                            if (loc.fileName() != null && !loc.fileName().isEmpty()) {
                                return " at " + loc.fileName() + " line " + loc.lineNumber();
                            }
                        }
                    }
                }
            }
        }

        // Fall back to JVM stack scanning for compiled Perl frames
        // Note: we skip org.perlonjava.runtime.perlmodule frames because those are
        // Java-implemented Perl builtins — we want the Perl caller's location.
        Throwable t = new Throwable();
        HashMap<ByteCodeSourceMapper.SourceLocation, String> locationToClassName = new HashMap<>();
        for (StackTraceElement element : t.getStackTrace()) {
            String className = element.getClassName();
            if (className.contains("org.perlonjava.anon")) {
                var loc = ByteCodeSourceMapper.parseStackTraceElement(element, locationToClassName);
                if (loc != null && loc.sourceFileName() != null && !loc.sourceFileName().isEmpty()) {
                    return " at " + loc.sourceFileName() + " line " + loc.lineNumber();
                }
            }
        }
        return "";
    }

    /**
     * Terminates execution with an error message. If a custom die handler is defined
     * in the global %SIG hash under the "__DIE__" key, it will be invoked with the
     * error message. Otherwise, a PerlCompilerException is thrown.
     *
     * @param message The error message to be issued.
     * @param where   Additional context or location information to append to the message.
     * @return A RuntimeBase representing the result of the die operation.
     * @throws PerlCompilerException if no custom die handler is defined.
     */
    public static RuntimeBase die(RuntimeBase message, RuntimeScalar where) {
        return die(message, where, null, 0);
    }

    public static RuntimeBase die(RuntimeBase message, RuntimeScalar where, String fileName, int lineNumber) {
        var errVariable = getGlobalVariable("main::@");
        var oldErr = new RuntimeScalar(errVariable);
        RuntimeScalar first = message.getFirst();
        boolean objectMessage = RuntimeScalarType.isReference(first)
                && first.type != RuntimeScalarType.REGEX;

        if (!objectMessage && message.toString().isEmpty()) {
            // Empty message
            message = dieEmptyMessage(oldErr, fileName, lineNumber);
            first = message.getFirst();
            objectMessage = RuntimeScalarType.isReference(first)
                    && first.type != RuntimeScalarType.REGEX;
        }
        if (!objectMessage) {
            // Error message
            String out = message.toString();
            if (!out.endsWith("\n")) {
                // Add " at FILE line N" location
                out += where.toString();
                // Add filehandle context if available (e.g., ", <DATA> chunk 1")
                String filehandleContext = getFilehandleContext();
                if (filehandleContext != null && !filehandleContext.isEmpty()) {
                    out += filehandleContext;
                }
                // Perl adds a period and newline to die messages
                if (!out.endsWith("\n")) {
                    out += ".\n";
                }
            }
            errVariable.set(out);
        } else {
            // Error object
            errVariable.set(first);
        }

        // System.out.println("die :" + errVariable);

        RuntimeScalar sig = getGlobalHash("main::SIG").get("__DIE__");
        if (sig.getDefinedBoolean() && !isReservedSigString(sig)) {
            RuntimeScalar sigHandler = new RuntimeScalar(sig);

            // Undefine $SIG{__DIE__} before calling the handler to avoid infinite recursion
            int level = DynamicVariableManager.getLocalLevel();
            DynamicVariableManager.pushLocalVariable(sig);

            boolean pushedEvalFrame = RuntimeCode.getEvalDepth() > 0
                    && InterpreterState.pushEvalFrameForCurrentInterpreter();
            try {
                // Perl passes the actual value stored in $@ to __DIE__.  For a
                // string exception that includes the source-location suffix;
                // passing the raw argument instead makes `die @_` rethrows add
                // the handler's location and loses the original stack site.
                // Pass a snapshot: the handler may run eval, which clears $@.
                // Perl still gives __DIE__ the formatted exception value, but
                // that value must not alias the mutable global while the
                // handler is executing.
                RuntimeList res = RuntimeCode.apply(sigHandler,
                        new RuntimeArray(new RuntimeScalar(errVariable)),
                        RuntimeContextType.SCALAR);

                // Handle TAILCALL with trampoline loop (for goto &sub in __DIE__ handlers)
                while (res.isNonLocalGoto()) {
                    RuntimeControlFlowList flow = (RuntimeControlFlowList) res;
                    if (flow.getControlFlowType() == ControlFlowType.TAILCALL) {
                        RuntimeScalar codeRef = flow.getTailCallCodeRef();
                        RuntimeArray callArgs = flow.getTailCallArgs();
                        res = RuntimeCode.apply(codeRef, "tailcall", callArgs, RuntimeContextType.SCALAR);
                    } else {
                        break;
                    }
                }
            } finally {
                if (pushedEvalFrame) {
                    InterpreterState.pop();
                }
                // Restore $SIG{__DIE__}
                DynamicVariableManager.popToLocalLevel(level);
            }

            throw new PerlDieException(errVariable, snapshotWarningHandler());
        }

        throw new PerlDieException(errVariable, snapshotWarningHandler());
    }

    private static RuntimeScalar snapshotWarningHandler() {
        RuntimeScalar handler = getGlobalHash("main::SIG").get("__WARN__");
        if (handler == null || !handler.getDefinedBoolean() || isReservedSigString(handler)) {
            return null;
        }
        RuntimeScalar retained = new RuntimeScalar();
        retained.set(handler);
        RuntimeScalar previous = PerlRuntime.current().executionState()
                .pendingThreadWarningHandler;
        if (previous != null) {
            RuntimeScalar.scopeExitCleanup(previous);
        }
        PerlRuntime.current().executionState().pendingThreadWarningHandler = retained;
        return retained;
    }

    private static RuntimeBase dieEmptyMessage(RuntimeScalar oldErr, String fileName, int lineNumber) {
        if (oldErr.getDefinedBoolean() && !oldErr.toString().isEmpty()) {
            // Check if $@ contains an object reference with a PROPAGATE method
            if (RuntimeScalarType.isReference(oldErr)) {

                // Use Universal.can to check if the object has a PROPAGATE method
                RuntimeArray canArgs = new RuntimeArray();
                RuntimeArray.push(canArgs, oldErr);
                RuntimeArray.push(canArgs, new RuntimeScalar("PROPAGATE"));
                RuntimeList canResult = Universal.can(canArgs, RuntimeContextType.SCALAR);

                if (canResult.size() == 1 && canResult.getFirst().getBoolean()) {
                    // The object has a PROPAGATE method, call it with file and line info
                    RuntimeScalar propagateMethod = canResult.getFirst();
                    RuntimeArray propagateArgs = new RuntimeArray();
                    RuntimeArray.push(propagateArgs, oldErr); // self
                    RuntimeArray.push(propagateArgs, new RuntimeScalar(fileName)); // __FILE__
                    RuntimeArray.push(propagateArgs, new RuntimeScalar(lineNumber)); // __LINE__

                    try {
                        return RuntimeCode.apply(propagateMethod, propagateArgs, RuntimeContextType.SCALAR).scalar();
                    } catch (Exception e) {
                        return oldErr;
                    }
                } else {
                    return oldErr;
                }
            } else {
                // $@ is not an object reference, append ...propagated
                return new RuntimeScalar(oldErr + "\t...propagated");
            }
        } else {
            // $@ is empty, use "Died"
            return new RuntimeScalar("Died");
        }
    }

    /**
     * Terminates the program by throwing PerlExitException.
     * <p>
     * This allows embedded/library use where the calling Java application
     * can catch the exception and continue execution. The CLI (Main.main())
     * catches this and converts it to a real System.exit() call.
     *
     * @param runtimeScalar with exit status
     * @return nothing (always throws)
     * @throws PerlExitException always thrown with the exit code
     */
    public static RuntimeScalar exit(RuntimeScalar runtimeScalar) {
        int exitCode = runtimeScalar.getInt();
        PerlRuntime runtime = PerlRuntime.current();
        if (runtime.perlThreadId() != 0 && runtime.perlThreadExitOnly()) {
            throw new PerlThreadExitException(new RuntimeArray(RuntimeScalarCache.scalarUndef));
        }
        // Set $? to the exit code before running END blocks (Perl 5 semantics).
        // From perlvar: "Inside an END subroutine $? contains the value that
        // is going to be given to exit(). You can modify $? in an END
        // subroutine to change the exit status of your program."
        getGlobalVariable("main::?").set(exitCode);
        // Flush file-scoped lexical cleanup before END blocks
        MortalList.flush();
        // Match normal shutdown: destroy captures unrelated to END now, while
        // preserving values reachable by END/global CODE until END completes.
        MortalList.flushDeferredCapturesBeforeEnd();
        try {
            runEndBlocks(false);  // Don't reset $? - we just set it to the exit code
        } catch (Throwable t) {
            RuntimeRegex.emitCurrentRuntimeDebugFreeTraces();
            RuntimeIO.closeAllHandles();
            String errorMessage = ErrorMessageUtil.stringifyException(t);
            System.err.println(errorMessage);
            throw new PerlExitException(1);
        } finally {
            MortalList.flushDeferredCaptures();
        }
        RuntimeRegex.emitCurrentRuntimeDebugFreeTraces();
        // Global destruction: walk stashes for tracked blessed objects
        GlobalDestruction.runGlobalDestruction();
        RuntimeIO.closeAllHandles();
        // Use $? as the final exit code - END blocks may have modified it
        int finalExitCode = getGlobalVariable("main::?").getInt();
        throw new PerlExitException(finalExitCode);
    }

    /**
     * Gets the current filehandle context for error messages.
     * Returns a string like ", <DATA> line 1" or ", <DATA> chunk 1" if a
     * filehandle is currently active. Uses "chunk" when $/ is set to ""
     * (paragraph mode), "line" otherwise. Matches Perl 5's behavior.
     *
     * @return String with filehandle context (including leading ", "), or null if no context
     */
    public static String getFilehandleContext() {
        if (RuntimeIO.getLastAccessedHandle() != null && RuntimeIO.getLastAccessedHandle().currentLineNumber > 0) {
            String handleName = findFilehandleName(RuntimeIO.getLastAccessedHandle());
            if (handleName != null) {
                // Perl 5 uses "line" only when $/ is exactly "\n".
                // Everything else (undef, "", custom separator, ref) uses "chunk".
                String unit = "chunk";
                try {
                    RuntimeScalar rs = GlobalVariable.getGlobalVariable("main::/");
                    if (rs.type != RuntimeScalarType.UNDEF && "\n".equals(rs.toString())) {
                        unit = "line";
                    }
                } catch (Exception ignored) {
                    // Default to "chunk" if we can't read $/
                }
                return ", <" + handleName + "> " + unit + " " + RuntimeIO.getLastAccessedHandle().currentLineNumber;
            }
        }
        return null;
    }

    /**
     * Attempts to find the variable name for a given filehandle.
     * Uses the glob name stored on the RuntimeIO handle.
     *
     * @param handle The RuntimeIO handle to find the name for
     * @return String with the bare handle name (e.g., "DATA", "STDIN"), or null if not found
     */
    private static String findFilehandleName(RuntimeIO handle) {
        if (handle.globName != null && !handle.globName.isEmpty()) {
            // Strip package prefix (e.g., "main::DATA" -> "DATA")
            String name = handle.globName;
            int colonIdx = name.lastIndexOf("::");
            if (colonIdx >= 0 && colonIdx + 2 < name.length()) {
                name = name.substring(colonIdx + 2);
            }
            return name;
        }
        // Fall back to the variable name set during the last readline (e.g., "$f")
        return RuntimeIO.getLastReadlineHandleName();
    }
}