diff --git a/src/alcotest-engine/core.ml b/src/alcotest-engine/core.ml index 459686d0..bbce2300 100644 --- a/src/alcotest-engine/core.ml +++ b/src/alcotest-engine/core.ml @@ -20,6 +20,9 @@ open Model exception Check_error of unit Fmt.t exception Skip +exception SegFault of string + +let _ = Callback.register_exception "segfault exception" (SegFault "Caught segfault") let () = let print_error = @@ -59,6 +62,7 @@ module Make (P : Platform.MAKER) (M : Monad.S) = struct type speed_level = [ `Quick | `Slow ] exception Test_error + exception SegFault = SegFault type 'a test_case = string * speed_level * 'a run @@ -82,6 +86,8 @@ module Make (P : Platform.MAKER) (M : Monad.S) = struct stderr : Formatters.stderr; } + external setup_stub_exception_handler: unit -> unit = "caml_setup_stub_exception_handler" + let gen_run_id = let random_state = lazy (Random.State.make_self_init ()) in let random_hex _ = @@ -443,7 +449,9 @@ module Make (P : Platform.MAKER) (M : Monad.S) = struct ?compact ?tail_errors ?quick_only ?show_errors ?json ?filter ?log_dir ?bail ?record_backtrace ?ci - let run = Config.User.kcreate run' + let run = + setup_stub_exception_handler (); + Config.User.kcreate run' end module V1 = struct @@ -451,4 +459,5 @@ module V1 = struct module Make = Make exception Skip = Skip + exception SegFault = SegFault end diff --git a/src/alcotest-engine/core_intf.ml b/src/alcotest-engine/core_intf.ml index 4d602276..e22f9b84 100644 --- a/src/alcotest-engine/core_intf.ml +++ b/src/alcotest-engine/core_intf.ml @@ -36,6 +36,8 @@ module V1_types = struct exception Test_error (** The exception return by {!run} in case of errors. *) + + exception SegFault of string val test_case : string -> speed_level -> ('a -> return) -> 'a test_case (** [test_case n s f] is the test case [n] running at speed [s] using the @@ -111,6 +113,7 @@ end module type Core = sig exception Check_error of unit Fmt.t + exception SegFault of string module V1 : sig module type S = V1_types.S @@ -123,5 +126,6 @@ module type Core = sig Intended for use by the {!Alcotest_lwt} and {!Alcotest_async} backends. *) exception Skip + exception SegFault of string end end diff --git a/src/alcotest-engine/dune b/src/alcotest-engine/dune index 5dbe572d..583fc4a1 100644 --- a/src/alcotest-engine/dune +++ b/src/alcotest-engine/dune @@ -15,9 +15,26 @@ %{target} "let get ?__FUNCTION__ () =\n ignore __FUNCTION__;\n None\n"))) +(rule + (target c_library_flags.sexp) + (enabled_if (= %{os_type} Win32)) + (action + (write-file %{target} "(-ldbghelp)"))) + +(rule + (target c_library_flags.sexp) + (enabled_if (or (<> %{os_type} Win32) (= %{architecture} "js"))) + (action + (write-file %{target} "()"))) + (library (name alcotest_engine) (public_name alcotest.engine) + (foreign_stubs + (language c) + (names stack_error_reporter)) + (c_library_flags (:standard (:include c_library_flags.sexp))) + (js_of_ocaml (javascript_files stack_error_reporter.js)) (libraries alcotest.stdlib_ext fmt diff --git a/src/alcotest-engine/stack_error_reporter.c b/src/alcotest-engine/stack_error_reporter.c new file mode 100644 index 00000000..ce950dc8 --- /dev/null +++ b/src/alcotest-engine/stack_error_reporter.c @@ -0,0 +1,223 @@ +// caml headers +#include +#include +#include +#include +#include + +#include +#include + +#define CRASH_BUFFER_SIZE 10240 +static char crash_buffer[CRASH_BUFFER_SIZE]; + +typedef struct { + char *buffer; + size_t capacity; + size_t offset; +} StackTraceBuffer; + +static bool finit_stack_trace_buffer(StackTraceBuffer *pStackTraceBuffer, + size_t size) { + pStackTraceBuffer->capacity = size; + pStackTraceBuffer->offset = 0; + pStackTraceBuffer->buffer = crash_buffer; + pStackTraceBuffer->buffer[0] = '\0'; + return true; +} + +static void append_to_buffer(StackTraceBuffer *sb, const char *format, ...) { + if (sb->offset >= sb->capacity) + return; // Buffer full + + va_list args; + va_start(args, format); + + size_t remaining = sb->capacity - sb->offset; + int written = vsnprintf(sb->buffer + sb->offset, remaining, format, args); + + va_end(args); + + if (written > 0) { + if ((size_t)written < remaining) { + sb->offset += written; + } else { + // Truncated or filled exactly; ensure null termination at the end + sb->offset = sb->capacity - 1; + sb->buffer[sb->offset] = '\0'; + } + } +} + +static const char *CAML_ERROR_ID = "segfault exception"; + +#if defined(_WIN32) +// clang-format off +#include +#include +#include +// clang-format on + +// Stacktrace collection inspired by +// https://smhk.net/note/2025/03/c-stack-trace-in-windows/ +static void create_stacktrace(StackTraceBuffer *pStackTraceBuffer) { + HANDLE process = GetCurrentProcess(); + HANDLE thread = GetCurrentThread(); + CONTEXT context; + STACKFRAME64 stack; + DWORD machine_type; + + RtlCaptureContext(&context); + + ZeroMemory(&stack, sizeof(STACKFRAME64)); + +#if defined(_M_IX86) || defined(__i386__) + machine_type = IMAGE_FILE_MACHINE_I386; + stack.AddrPC.Offset = context.Eip; + stack.AddrFrame.Offset = context.Ebp; + stack.AddrStack.Offset = context.Esp; +#elif defined(_M_X64) || defined(__x86_64__) + machine_type = IMAGE_FILE_MACHINE_AMD64; + stack.AddrPC.Offset = context.Rip; + stack.AddrFrame.Offset = context.Rsp; + stack.AddrStack.Offset = context.Rsp; +#elif defined(_M_ARM64) || defined(__aarch64__) + machine_type = IMAGE_FILE_MACHINE_ARM64; + stack.AddrPC.Offset = context.Pc; + stack.AddrFrame.Offset = context.Fp; + stack.AddrStack.Offset = context.Sp; +#else +#error "Unsupported platform" +#endif + + stack.AddrPC.Mode = AddrModeFlat; + stack.AddrFrame.Mode = AddrModeFlat; + stack.AddrStack.Mode = AddrModeFlat; + + SymInitialize(process, NULL, TRUE); + SymSetOptions(SYMOPT_LOAD_LINES | SYMOPT_UNDNAME); + + append_to_buffer(pStackTraceBuffer, "Stack trace:\n"); + append_to_buffer(pStackTraceBuffer, " %-40s %-18s %s\n", "Function", + "Address", "Line"); + append_to_buffer(pStackTraceBuffer, " %-40s %-18s %s\n", "--------", + "-------", "----"); + + while (StackWalk64(machine_type, process, thread, &stack, &context, NULL, + SymFunctionTableAccess64, SymGetModuleBase64, NULL)) { + if (stack.AddrPC.Offset == 0) + break; + + DWORD64 symbol_addr = stack.AddrPC.Offset; + DWORD64 displacement = 0; + alignas(SYMBOL_INFO *) char + symbol_buffer[sizeof(SYMBOL_INFO) + MAX_SYM_NAME * sizeof(TCHAR)] = {0}; + SYMBOL_INFO *symbol = (SYMBOL_INFO *)symbol_buffer; + symbol->SizeOfStruct = sizeof(SYMBOL_INFO); + symbol->MaxNameLen = MAX_SYM_NAME; + + // Get line information + IMAGEHLP_LINE64 line = {0}; + line.SizeOfStruct = sizeof(IMAGEHLP_LINE64); + DWORD line_displacement = 0; + BOOL has_line = + SymGetLineFromAddr64(process, symbol_addr, &line_displacement, &line); + + char function_name[MAX_SYM_NAME] = "Unknown"; + if (SymFromAddr(process, symbol_addr, &displacement, symbol)) { + strncpy(function_name, symbol->Name, MAX_SYM_NAME - 1); + function_name[MAX_SYM_NAME - 1] = '\0'; // Ensure null termination + } + // Format line information + char line_info[256] = "Unknown"; + if (has_line) { + snprintf(line_info, sizeof(line_info), "%s:%lu", line.FileName, + line.LineNumber); + } + + // Print with better alignment using format specifiers + append_to_buffer(pStackTraceBuffer, " %-40.40s 0x%016llX %s\n", + function_name, symbol_addr, line_info); + append_to_buffer(pStackTraceBuffer, "\0"); + } + + SymCleanup(process); +} + +static LONG WINAPI +windows_exception_handler(EXCEPTION_POINTERS *pExceptionInfo) { + const DWORD exceptionCode = pExceptionInfo->ExceptionRecord->ExceptionCode; + switch (exceptionCode) { + case EXCEPTION_ACCESS_VIOLATION: { + void *faulting_address = + (void *)pExceptionInfo->ExceptionRecord->ExceptionInformation[1]; + StackTraceBuffer stack_trace_buffer; + if (!finit_stack_trace_buffer(&stack_trace_buffer, CRASH_BUFFER_SIZE)) { + caml_failwith("Can't create stack trace buffer"); + return EXCEPTION_CONTINUE_SEARCH; + } + create_stacktrace(&stack_trace_buffer); + + caml_raise_with_string(*caml_named_value(CAML_ERROR_ID), + stack_trace_buffer.buffer); + free(stack_trace_buffer.buffer); + ExitProcess(STATUS_ACCESS_VIOLATION); + } + default: + break; + } + return EXCEPTION_CONTINUE_SEARCH; +} +#else +#include +#include +#include +#include + +#define STACK_TRACE_LENGTH 20 + +static void unix_signal_handler(int sig, siginfo_t *si, void *unused) { + + StackTraceBuffer stack_trace_buffer; + if (!finit_stack_trace_buffer(&stack_trace_buffer, CRASH_BUFFER_SIZE)) { + caml_failwith("Can't create stack trace buffer"); + return; + } + + void *trace[STACK_TRACE_LENGTH]; + size_t trace_size = backtrace(trace, STACK_TRACE_LENGTH); + + if (trace_size == 0) { + caml_failwith("Couldn't get backtrace"); + return; + } + + append_to_buffer(&stack_trace_buffer, + "Access violation caught, stacktrace:\n"); + + char **pSymbols = backtrace_symbols(trace, trace_size); + for (int i = 0; i < trace_size; ++i) { + append_to_buffer(&stack_trace_buffer, "%s\n", pSymbols[i]); + } + free(pSymbols); + + caml_raise_with_string(*caml_named_value(CAML_ERROR_ID), + stack_trace_buffer.buffer); + exit(WEXITED); +} +#endif + +CAMLprim value caml_setup_stub_exception_handler(void) { + CAMLparam0(); +#if defined(_WIN32) + AddVectoredExceptionHandler(1, windows_exception_handler); +#else + struct sigaction sa; + sa.sa_flags = SA_SIGINFO | SA_ONSTACK; + sigemptyset(&sa.sa_mask); + sa.sa_sigaction = unix_signal_handler; + sigaction(SIGSEGV, &sa, NULL); + sigaction(SIGBUS, &sa, NULL); // Catch SIGBUS as well for macOS +#endif + CAMLreturn(Val_unit); +} \ No newline at end of file diff --git a/src/alcotest-engine/stack_error_reporter.js b/src/alcotest-engine/stack_error_reporter.js new file mode 100644 index 00000000..1d258dd6 --- /dev/null +++ b/src/alcotest-engine/stack_error_reporter.js @@ -0,0 +1,6 @@ +//Provides: caml_setup_stub_exception_handler +function caml_setup_stub_exception_handler(unit) { + // Intentionally left empty + // This function is mainly for C stubs and Segfault errors + return; +} \ No newline at end of file diff --git a/test/e2e/alcotest/stubs/dune b/test/e2e/alcotest/stubs/dune new file mode 100644 index 00000000..e30a8087 --- /dev/null +++ b/test/e2e/alcotest/stubs/dune @@ -0,0 +1,29 @@ +(executable + (name nullexception) + (libraries alcotest) + (foreign_stubs + (language c) + (names nullexceptionstub)) + ) + +(rule + (target stubs.actual) + (action + (with-accepted-exit-codes + (or 1 2 124 125) + (with-outputs-to + %{target} + (run %{dep:nullexception.exe} --color=auto))))) + +(rule + (target stubs.processed) + (action + (with-outputs-to + %{target} + (run ../../strip_randomness.exe %{dep:stubs.actual})))) + +(rule + (alias runtest) + (package alcotest) + (action + (diff stubs.expected stubs.processed))) diff --git a/test/e2e/alcotest/stubs/nullexception.ml b/test/e2e/alcotest/stubs/nullexception.ml new file mode 100644 index 00000000..81e01609 --- /dev/null +++ b/test/e2e/alcotest/stubs/nullexception.ml @@ -0,0 +1,21 @@ +external segfault_call : unit -> unit = "caml_segfault_call" + +(* This test should fail *) +let () = + let open Alcotest in + let call_seg () = + try + segfault_call (); + (check pass) "Should get segfault exception" () () + with + | SegFault _ -> + fail "Got segfault" + | _ -> + fail "Got uncategorized exception" + in + run __FILE__ + [ + ("segfault", [ test_case "nullexcept" `Quick (function _ -> call_seg ())]); + ] + + diff --git a/test/e2e/alcotest/stubs/nullexceptionstub.c b/test/e2e/alcotest/stubs/nullexceptionstub.c new file mode 100644 index 00000000..884c07eb --- /dev/null +++ b/test/e2e/alcotest/stubs/nullexceptionstub.c @@ -0,0 +1,17 @@ +#include +#include + +#if !defined(_WIN32) +#include +#endif + +value caml_segfault_call(void) { + CAMLparam0(); + volatile int *p = (volatile int *)0; + *p = 0xDEADBEEF; + #if !defined(_WIN32) + // in case mac won't call segfault + raise(SIGSEGV); + #endif + CAMLreturn(Int_val(0)); +} \ No newline at end of file diff --git a/test/e2e/alcotest/stubs/stubs.expected b/test/e2e/alcotest/stubs/stubs.expected new file mode 100644 index 00000000..a1d83bda --- /dev/null +++ b/test/e2e/alcotest/stubs/stubs.expected @@ -0,0 +1,17 @@ +Testing `test/e2e/alcotest/stubs/nullexception.ml'. +This run has ID `'. + +> [FAIL] segfault 0 nullexcept. + +┌──────────────────────────────────────────────────────────────────────────────┐ +│ [FAIL] segfault 0 nullexcept. │ +└──────────────────────────────────────────────────────────────────────────────┘ +ASSERT Got segfault +FAIL Got segfault + + +Logs saved to `/_build/_tests//segfault.000.output'. + ────────────────────────────────────────────────────────────────────────────── + +Full test results in `/_build/_tests/'. +1 failure! in s. 1 test run.