rpms/ocaml
7
0
Fork 0
Code Issues Pull Requests Releases Activity

Version 5.2.0

Browse Source 
- Drop upstreamed frame pointer and s390x patches
This commit is contained in:
Jerry James 2024-05-23 09:00:25 -06:00
parent a3771460e1
commit f299c84c6d
6 changed files with 21 additions and 748 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
0001-Don-t-add-rpaths-to-libraries.patch
View File

@ -1,7 +1,7 @@
From 799bf9088c131fc71626a48e9987e4d44a2f0194 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 24 Jun 2014 10:00:15 +0100
Subject: [PATCH 1/4] Don't add rpaths to libraries.
Subject: [PATCH 1/2] Don't add rpaths to libraries.
---
configure.ac | 2 --
@ -11,8 +11,8 @@ diff --git a/configure.ac b/configure.ac
index b81da53c42..892a2a894f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1107,8 +1107,6 @@ AS_IF([test x"$enable_shared" != "xno"],
[[*-*-openbsd7.[3-9]|*-*-openbsd[89].*]],
@@ -1221,8 +1221,6 @@ AS_IF([test x"$enable_shared" != "xno"],
[[*-*-openbsd7.[3-9]|*-*-openbsd[89].*]],
[mkdll_flags="${mkdll_flags} -Wl,--no-execute-only"])
oc_ldflags="$oc_ldflags -Wl,-E"
- rpath="-Wl,-rpath,"

12
0002-configure-Allow-user-defined-C-compiler-flags.patch
View File

@ -1,7 +1,7 @@
From f2b875e8201efed22267136096b1e5df97f99f84 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 29 May 2012 20:44:18 +0100
Subject: [PATCH 2/4] configure: Allow user defined C compiler flags.
Subject: [PATCH 2/2] configure: Allow user defined C compiler flags.
---
configure.ac | 8 ++++++--
@ -11,9 +11,9 @@ diff --git a/configure.ac b/configure.ac
index 892a2a894f..e8f6cbc863 100644
--- a/configure.ac
+++ b/configure.ac
@@ -760,6 +760,10 @@ AS_CASE([$host],
internal_cflags="$cc_warnings"],
[common_cflags="-O"])])
@@ -869,6 +869,10 @@ AS_CASE([$ocaml_cc_vendor],
internal_cflags="$cc_warnings"],
[common_cflags="-O"])
+# Allow CFLAGS and LDFLAGS to be added.
+common_cflags="$common_cflags $CFLAGS"
@ -22,7 +22,7 @@ index 892a2a894f..e8f6cbc863 100644
# Enable SSE2 on x86 mingw to avoid using 80-bit registers.
AS_CASE([$host],
[i686-*-mingw32*],
@@ -2327,7 +2331,7 @@ AC_CONFIG_COMMANDS_PRE([
@@ -2648,7 +2652,7 @@ AC_CONFIG_COMMANDS_PRE([
[mkexedebugflag="${mkexe_ldflags_prefix}${mkexedebugflag}"])
mkdll_ldflags=""
AS_IF([test -n "${LDFLAGS}"],
@ -31,7 +31,7 @@ index 892a2a894f..e8f6cbc863 100644
mkdll_ldflags="${mkdll_ldflags} ${mkexe_ldflags_prefix}${flag}"
done
mkdll_ldflags_exp="$mkdll_ldflags"])
@@ -2353,7 +2357,7 @@ ${mkdll_ldflags}"
@@ -2674,7 +2678,7 @@ ${mkdll_ldflags}"
],[
mkdll_ldflags='$(OC_DLL_LDFLAGS) $(LDFLAGS)'
mkdll_ldflags_exp="${oc_dll_ldflags}"

696
0003-Update-framepointers-tests-to-avoid-false-positive-w.patch
View File

@ -1,696 +0,0 @@
From ba44a9c29771aacf44222a2ff63e7bd6034dd92c Mon Sep 17 00:00:00 2001
From: Fabrice Buoro <fabrice@tarides.com>
Date: Fri, 10 Mar 2023 09:36:22 -0700
Subject: [PATCH 3/4] Update framepointers tests to avoid false positive with
inlined C functions
---
testsuite/tests/frame-pointers/c_call.ml | 14 +-
.../tests/frame-pointers/c_call.reference | 9 -
testsuite/tests/frame-pointers/c_call.run | 4 -
testsuite/tests/frame-pointers/c_call_.c | 14 +-
testsuite/tests/frame-pointers/effects.ml | 12 +-
.../tests/frame-pointers/effects.reference | 15 --
testsuite/tests/frame-pointers/effects.run | 4 -
.../tests/frame-pointers/exception_handler.ml | 4 +-
.../exception_handler.reference | 12 --
.../frame-pointers/exception_handler.run | 4 -
.../tests/frame-pointers/filter-locations.sh | 23 ---
testsuite/tests/frame-pointers/fp_backtrace.c | 186 +++++++++++-------
testsuite/tests/frame-pointers/reperform.ml | 4 +-
.../tests/frame-pointers/reperform.reference | 3 -
testsuite/tests/frame-pointers/reperform.run | 4 -
.../tests/frame-pointers/stack_realloc.ml | 4 +-
.../frame-pointers/stack_realloc.reference | 3 -
.../tests/frame-pointers/stack_realloc.run | 4 -
.../tests/frame-pointers/stack_realloc2.ml | 4 +-
.../frame-pointers/stack_realloc2.reference | 3 -
.../tests/frame-pointers/stack_realloc2.run | 4 -
21 files changed, 144 insertions(+), 190 deletions(-)
delete mode 100644 testsuite/tests/frame-pointers/c_call.run
delete mode 100644 testsuite/tests/frame-pointers/effects.run
delete mode 100644 testsuite/tests/frame-pointers/exception_handler.run
delete mode 100755 testsuite/tests/frame-pointers/filter-locations.sh
delete mode 100644 testsuite/tests/frame-pointers/reperform.run
delete mode 100644 testsuite/tests/frame-pointers/stack_realloc.run
delete mode 100644 testsuite/tests/frame-pointers/stack_realloc2.run
diff --git a/testsuite/tests/frame-pointers/c_call.ml b/testsuite/tests/frame-pointers/c_call.ml
index c2493b3a99..9b98e86520 100644
--- a/testsuite/tests/frame-pointers/c_call.ml
+++ b/testsuite/tests/frame-pointers/c_call.ml
@@ -7,20 +7,20 @@ all_modules = "${readonly_files} c_call.ml"
*)
-external fp_backtrace : unit -> unit = "fp_backtrace"
-external fp_backtrace_no_alloc : unit -> unit = "fp_backtrace" [@@noalloc]
-external fp_backtrace_many_args : int -> int -> int -> int -> int -> int -> int
- -> int -> int -> int -> int -> unit =
+external fp_backtrace : string -> unit = "fp_backtrace"
+external fp_backtrace_no_alloc : string -> unit = "fp_backtrace" [@@noalloc]
+external fp_backtrace_many_args : string -> int -> int -> int -> int -> int
+ -> int -> int -> int -> int -> int -> int -> unit =
"fp_backtrace_many_args_argv" "fp_backtrace_many_args"
let[@inline never] f () =
(* Check backtrace through caml_c_call_stack_args *)
- fp_backtrace_many_args 1 2 3 4 5 6 7 8 9 10 11;
+ fp_backtrace_many_args Sys.argv.(0) 1 2 3 4 5 6 7 8 9 10 11;
(* Check backtrace through caml_c_call.
* Also check that caml_c_call_stack_args correctly restores rbp register *)
- fp_backtrace ();
+ fp_backtrace Sys.argv.(0);
(* Check caml_c_call correctly restores rbp register *)
- fp_backtrace_no_alloc ();
+ fp_backtrace_no_alloc Sys.argv.(0);
42
let () = ignore (f ())
diff --git a/testsuite/tests/frame-pointers/c_call.reference b/testsuite/tests/frame-pointers/c_call.reference
index 92fb40a238..23095e7431 100644
--- a/testsuite/tests/frame-pointers/c_call.reference
+++ b/testsuite/tests/frame-pointers/c_call.reference
@@ -3,19 +3,10 @@ caml_c_call_stack_args
camlC_call.f
camlC_call.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
caml_c_call
camlC_call.f
camlC_call.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
camlC_call.f
camlC_call.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
diff --git a/testsuite/tests/frame-pointers/c_call.run b/testsuite/tests/frame-pointers/c_call.run
deleted file mode 100644
index e96b5ea13a..0000000000
--- a/testsuite/tests/frame-pointers/c_call.run
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/sh
-
-${program} 2>&1 \
- | ${test_source_directory}/filter-locations.sh ${program} >${output}
diff --git a/testsuite/tests/frame-pointers/c_call_.c b/testsuite/tests/frame-pointers/c_call_.c
index 634c4dd937..a75100b213 100644
--- a/testsuite/tests/frame-pointers/c_call_.c
+++ b/testsuite/tests/frame-pointers/c_call_.c
@@ -16,10 +16,10 @@
#include <assert.h>
#include "caml/mlvalues.h"
-void fp_backtrace(void);
+void fp_backtrace(value);
-value fp_backtrace_many_args(value a, value b, value c, value d, value e,
- value f, value g, value h, value i, value j, value k)
+value fp_backtrace_many_args(value argv0, value a, value b, value c,
+ value d, value e, value f, value g, value h, value i, value j, value k)
{
assert(Int_val(a) == 1);
assert(Int_val(b) == 2);
@@ -33,15 +33,15 @@ value fp_backtrace_many_args(value a, value b, value c, value d, value e,
assert(Int_val(j) == 10);
assert(Int_val(k) == 11);
- fp_backtrace();
+ fp_backtrace(argv0);
return Val_unit;
}
-value fp_bactrace_many_args_argv(value *argv, int argc)
+value fp_bactrace_many_args_argv(value argv0, value *argv, int argc)
{
assert(argc == 11);
- return fp_backtrace_many_args(argv[0], argv[1], argv[2], argv[3], argv[4],
- argv[5], argv[6], argv[7], argv[8], argv[9], argv[10]);
+ return fp_backtrace_many_args(argv0, argv[0], argv[1], argv[2], argv[3],
+ argv[4], argv[5], argv[6], argv[7], argv[8], argv[9], argv[10]);
}
diff --git a/testsuite/tests/frame-pointers/effects.ml b/testsuite/tests/frame-pointers/effects.ml
index e14633a374..4d14190320 100644
--- a/testsuite/tests/frame-pointers/effects.ml
+++ b/testsuite/tests/frame-pointers/effects.ml
@@ -11,26 +11,26 @@ open Printf
open Effect
open Effect.Deep
-external fp_backtrace : unit -> unit = "fp_backtrace" [@@noalloc]
+external fp_backtrace : string -> unit = "fp_backtrace" [@@noalloc]
type _ t += E : int -> int t
let[@inline never] f () =
printf "# computation f\n%!";
- fp_backtrace ();
+ fp_backtrace Sys.argv.(0);
printf "# perform effect (E 0)\n%!";
let v = perform (E 0) in
printf "# perform returns %d\n%!" v;
- fp_backtrace ();
+ fp_backtrace Sys.argv.(0);
v + 1
let h (type a) (eff : a t) : ((a, 'b) continuation -> 'b) option =
let[@inline never] h_effect_e v k =
printf "# caught effect (E %d). continuing...\n%!" v;
- fp_backtrace ();
+ fp_backtrace Sys.argv.(0);
let v = continue k (v + 1) in
printf "# continue returns %d\n%!" v;
- fp_backtrace ();
+ fp_backtrace Sys.argv.(0);
v + 1
in
match eff with
@@ -41,7 +41,7 @@ let h (type a) (eff : a t) : ((a, 'b) continuation -> 'b) option =
let v =
let[@inline never] v_retc v =
printf "# done %d\n%!" v;
- fp_backtrace ();
+ fp_backtrace Sys.argv.(0);
v + 1
in
match_with f ()
diff --git a/testsuite/tests/frame-pointers/effects.reference b/testsuite/tests/frame-pointers/effects.reference
index c8bd0a391a..8ae3fc26df 100644
--- a/testsuite/tests/frame-pointers/effects.reference
+++ b/testsuite/tests/frame-pointers/effects.reference
@@ -3,39 +3,24 @@ camlEffects.f
caml_runstack
camlEffects.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
# perform effect (E 0)
# caught effect (E 0). continuing...
camlEffects.h_effect_e
camlEffects.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
# perform returns 1
camlEffects.f
caml_runstack
camlEffects.h_effect_e
camlEffects.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
# done 2
camlEffects.v_retc
camlEffects.h_effect_e
camlEffects.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
# continue returns 3
camlEffects.h_effect_e
camlEffects.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
# result=4
diff --git a/testsuite/tests/frame-pointers/effects.run b/testsuite/tests/frame-pointers/effects.run
deleted file mode 100644
index e96b5ea13a..0000000000
--- a/testsuite/tests/frame-pointers/effects.run
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/sh
-
-${program} 2>&1 \
- | ${test_source_directory}/filter-locations.sh ${program} >${output}
diff --git a/testsuite/tests/frame-pointers/exception_handler.ml b/testsuite/tests/frame-pointers/exception_handler.ml
index 575f7329bf..95a4f0d75c 100644
--- a/testsuite/tests/frame-pointers/exception_handler.ml
+++ b/testsuite/tests/frame-pointers/exception_handler.ml
@@ -8,7 +8,7 @@ all_modules = "${readonly_files} exception_handler.ml"
*)
(* https://github.com/ocaml/ocaml/pull/11031 *)
-external fp_backtrace : unit -> unit = "fp_backtrace" [@@noalloc]
+external fp_backtrace : string -> unit = "fp_backtrace" [@@noalloc]
exception Exn1
exception Exn2
@@ -38,7 +38,7 @@ let[@inline never] handler () =
let _ = Sys.opaque_identity x0 in
let _ = Sys.opaque_identity x1 in
let _ = Sys.opaque_identity x2 in
- fp_backtrace ()
+ fp_backtrace Sys.argv.(0)
let[@inline never] nested i =
begin
diff --git a/testsuite/tests/frame-pointers/exception_handler.reference b/testsuite/tests/frame-pointers/exception_handler.reference
index 513ca488b9..e012fb6d4f 100644
--- a/testsuite/tests/frame-pointers/exception_handler.reference
+++ b/testsuite/tests/frame-pointers/exception_handler.reference
@@ -2,27 +2,15 @@ camlException_handler.handler
camlException_handler.bare
camlException_handler.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
camlException_handler.handler
camlException_handler.bare
camlException_handler.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
camlException_handler.handler
camlException_handler.nested
camlException_handler.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
camlException_handler.handler
camlException_handler.nested
camlException_handler.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
diff --git a/testsuite/tests/frame-pointers/exception_handler.run b/testsuite/tests/frame-pointers/exception_handler.run
deleted file mode 100644
index e96b5ea13a..0000000000
--- a/testsuite/tests/frame-pointers/exception_handler.run
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/sh
-
-${program} 2>&1 \
- | ${test_source_directory}/filter-locations.sh ${program} >${output}
diff --git a/testsuite/tests/frame-pointers/filter-locations.sh b/testsuite/tests/frame-pointers/filter-locations.sh
deleted file mode 100755
index 31c7fc3189..0000000000
--- a/testsuite/tests/frame-pointers/filter-locations.sh
+++ /dev/null
@@ -1,23 +0,0 @@
-#!/bin/sh
-
-set -eu
-
-program="${1}"
-# https://stackoverflow.com/questions/29613304/is-it-possible-to-escape-regex-metacharacters-reliably-with-sed/29626460#29626460
-program_escaped=$(echo ${program} | sed 's/[^^\\]/[&]/g; s/\^/\\^/g; s/\\/\\\\/g')
-regex_backtrace='^.*(\(.*\)+0x[[:xdigit:]]*)[0x[[:xdigit:]]*]$'
-regex_trim_fun='^\(caml.*\)_[[:digit:]]*$'
-
-# - Ignore backtrace not coming from the program binary
-# - Discard the number suffix from OCaml function name
-# - Remove strange '[0x.....]' entries inserted by some implementation
-# of backtrace_symbols_fd
-# - Keep the other lines
-sed -e \
- "/${regex_backtrace}/ {
- /^${program_escaped}/ ! d
- s/${regex_backtrace}/\1/
- s/${regex_trim_fun}/\1/
- s;caml_\(main\|startup\);caml_main/caml_startup;
- }" \
- -e '/^\[0x/d'
diff --git a/testsuite/tests/frame-pointers/fp_backtrace.c b/testsuite/tests/frame-pointers/fp_backtrace.c
index a521218a38..cef7ccd9f2 100644
--- a/testsuite/tests/frame-pointers/fp_backtrace.c
+++ b/testsuite/tests/frame-pointers/fp_backtrace.c
@@ -1,10 +1,17 @@
#include <execinfo.h>
-#include <unistd.h>
-#include <setjmp.h>
-#include <signal.h>
+#include <regex.h>
+#include <stdbool.h>
#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
-#define ARRSIZE(a) (sizeof(a) / sizeof(*(a)))
+#include "caml/mlvalues.h"
+
+#define ARR_SIZE(a) (sizeof(a) / sizeof(*(a)))
+
+#define RE_FUNC_NAME "^.*\\((.+)\\+0x[[:xdigit:]]+\\) \\[0x[[:xdigit:]]+\\]$"
+#define RE_TRIM_FUNC "(caml.*)_[[:digit:]]+"
+#define CAML_ENTRY "caml_program"
typedef struct frame_info
{
@@ -12,99 +19,138 @@ typedef struct frame_info
void* retaddr; /* rip */
} frame_info;
-jmp_buf resume_buf;
+/*
+ * A backtrace symbol looks like:
+ * ./path/to/binary(camlModule_fn_123+0xAABBCC) [0xAABBCCDDEE]
+ */
+static const char* backtrace_symbol(const struct frame_info* fi)
+{
+ char** symbols = backtrace_symbols(&fi->retaddr, 1);
+ if (!symbols) {
+ perror("backtrace_symbols");
+ return NULL;
+ }
-static void signal_handler(int signum)
+ const char* symbol = strdup(symbols[0]);
+ free(symbols);
+ return symbol;
+}
+
+static bool is_from_executable(const char* symbol, const char* execname)
{
- /* Should be safe to be called from a signal handler.
- * See 21.2.1 "Performing a nonlocal goto from a signal handler" from
- * The Linux Programming Interface, Michael Kerrisk */
- siglongjmp(resume_buf, 1);
+ return strncmp(symbol, execname, strlen(execname)) == 0;
}
-static int install_signal_handlers(const int signals[], struct sigaction
- handlers[], int count)
+static regmatch_t func_name_from_symbol(const char* symbol)
{
- for (int i = 0; i < count; i++) {
- struct sigaction action = { 0 };
- action.sa_handler = signal_handler;
- sigemptyset(&action.sa_mask);
- action.sa_flags = 0;
-
- if (sigaction(signals[i], &action, &handlers[i]) != 0) {
- perror("sigaction");
- return -1;
- }
+ regex_t regex;
+ regmatch_t match[2] = { {-1, -1}, {-1, -1}};
+ char errbuf[128];
+ int err;
+
+ err = regcomp(&regex, RE_FUNC_NAME, REG_EXTENDED);
+ if (err) {
+ regerror(err, &regex, errbuf, ARR_SIZE(errbuf));
+ fprintf(stderr, "regcomp: %s\n", errbuf);
+ return match[0];
}
- return 0;
+
+ err = regexec(&regex, symbol, ARR_SIZE(match), match, 0);
+ if (err == REG_NOMATCH)
+ return match[0];
+
+ return match[1];
}
-static int restore_signal_handlers(const int signals[], struct sigaction
- handlers[], int count)
+static bool is_caml_entry(const char* symbol, const regmatch_t* funcname)
{
- for (int i = 0; i < count; i++) {
- if (sigaction(signals[i], &handlers[i], NULL) != 0) {
- perror("sigaction");
- return -1;
- }
- }
- return 0;
+ //regoff_t len = funcname->rm_eo - funcname->rm_so;
+ //return strnstr(symbol + funcname->rm_so, CAML_ENTRY, len) == 0;
+ return strstr(symbol + funcname->rm_so, CAML_ENTRY) != NULL;
}
-static int safe_read(const struct frame_info* fi, struct frame_info** prev,
- void** retaddr)
+static regmatch_t trim_func_name(const char* symbol, const regmatch_t* funcname)
{
- /* Signals to ignore while attempting to read frame_info members */
- const int signals[] = { SIGSEGV, SIGBUS };
- /* Store original signal handers */
- struct sigaction handlers[ARRSIZE(signals)] = { 0 };
- int ret = 0;
-
- if (install_signal_handlers(signals, handlers, ARRSIZE(signals)) != 0)
- return -1;
-
- if (!sigsetjmp(resume_buf, 1)) {
- *prev = fi->prev;
- *retaddr = fi->retaddr;
- } else {
- ret = -1;
+ regex_t regex;
+ regmatch_t match[2] = { {-1, -1}, {-1, -1}};
+ char errbuf[128];
+ int err;
+
+ err = regcomp(&regex, RE_TRIM_FUNC, REG_EXTENDED);
+ if (err) {
+ regerror(err, &regex, errbuf, ARR_SIZE(errbuf));
+ fprintf(stderr, "regcomp: %s\n", errbuf);
+ return match[0];
}
- if (restore_signal_handlers(signals, handlers, ARRSIZE(signals)) != 0)
- return -1;
+ match[0] = *funcname;
+ err = regexec(&regex, symbol, ARR_SIZE(match), match, REG_STARTEND);
+ if (err == REG_NOMATCH) {
+ /* match[0] has already been overwritten to hold the function full name for
+ regexec */
+ return match[1];
+ }
- return ret;
+ return match[1];
}
-static void print_location(void* addr)
+static void print_symbol(const char* symbol, const regmatch_t* match)
{
- if (!addr)
- return;
+ regoff_t off = match->rm_so;
+ regoff_t len = match->rm_eo - match->rm_so;
- /* This requires the binary to be linked with '-rdynamic' */
- backtrace_symbols_fd(&addr, 1, STDOUT_FILENO);
+ fprintf(stdout, "%.*s\n", len, symbol + off);
+ fflush(stdout);
}
-void fp_backtrace(void)
+void fp_backtrace(value argv0)
{
- struct frame_info *fi;
- struct frame_info* next;
- void* retaddr;
-
- fi = __builtin_frame_address(0);
- retaddr = __builtin_extract_return_addr(__builtin_return_address(0));
-
- for (; fi; fi = next) {
- if (safe_read(fi, &next, &retaddr) != 0)
- return;
+ const char* execname = String_val(argv0);
+ struct frame_info* next = NULL;
+ const char* symbol = NULL;
- print_location(retaddr);
+ for (struct frame_info* fi = __builtin_frame_address(0); fi; fi = next) {
+ next = fi->prev;
/* Detect the simplest kind of infinite loop */
if (fi == next) {
- printf("fp_backtrace: loop detected\n");
- return;
+ fprintf(stderr, "fp_backtrace: loop detected\n");
+ break;
}
+
+ symbol = backtrace_symbol(fi);
+ if (!symbol)
+ continue;
+
+ /* Skip entries not from the test */
+ if (!is_from_executable(symbol, execname))
+ goto skip;
+
+ /* Exctract the full function name */
+ regmatch_t funcname = func_name_from_symbol(symbol);
+ if (funcname.rm_so == -1)
+ goto skip;
+
+ /* Trim numeric suffix from caml functions */
+ regmatch_t functrimmed = trim_func_name(symbol, &funcname);
+
+ /* Use the trimmed caml name if available, otherwise use the full function
+ name */
+ const regmatch_t* match = (functrimmed.rm_so != -1) ?
+ &functrimmed : &funcname;
+
+ print_symbol(symbol, match);
+
+ /* Stop the backtrace at caml_program */
+ if (is_caml_entry(symbol, &funcname))
+ break;
+
+skip:
+ free((void*)symbol);
+ symbol = NULL;
}
+
+ if (symbol)
+ free((void*)symbol);
}
diff --git a/testsuite/tests/frame-pointers/reperform.ml b/testsuite/tests/frame-pointers/reperform.ml
index 1af8452e5f..da251c98a7 100644
--- a/testsuite/tests/frame-pointers/reperform.ml
+++ b/testsuite/tests/frame-pointers/reperform.ml
@@ -11,7 +11,7 @@ all_modules = "${readonly_files} reperform.ml"
open Effect
open Effect.Deep
-external fp_backtrace : unit -> unit = "fp_backtrace" [@@noalloc]
+external fp_backtrace : string -> unit = "fp_backtrace" [@@noalloc]
type _ Effect.t += E : unit t
| F : unit t
@@ -22,7 +22,7 @@ let rec foo n =
if n = 5 then begin
perform E;
print_endline "# resumed...";
- fp_backtrace ()
+ fp_backtrace Sys.argv.(0)
end;
foo (n + 1) + n
end
diff --git a/testsuite/tests/frame-pointers/reperform.reference b/testsuite/tests/frame-pointers/reperform.reference
index 9ac6681d4b..e215f77169 100644
--- a/testsuite/tests/frame-pointers/reperform.reference
+++ b/testsuite/tests/frame-pointers/reperform.reference
@@ -15,6 +15,3 @@ camlReperform.bar
caml_runstack
camlReperform.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
diff --git a/testsuite/tests/frame-pointers/reperform.run b/testsuite/tests/frame-pointers/reperform.run
deleted file mode 100644
index e96b5ea13a..0000000000
--- a/testsuite/tests/frame-pointers/reperform.run
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/sh
-
-${program} 2>&1 \
- | ${test_source_directory}/filter-locations.sh ${program} >${output}
diff --git a/testsuite/tests/frame-pointers/stack_realloc.ml b/testsuite/tests/frame-pointers/stack_realloc.ml
index 79e70c2add..f24e4795d5 100644
--- a/testsuite/tests/frame-pointers/stack_realloc.ml
+++ b/testsuite/tests/frame-pointers/stack_realloc.ml
@@ -13,7 +13,7 @@ open Effect.Deep
type _ t += E : int -> int t
-external fp_backtrace : unit -> unit = "fp_backtrace" [@@noalloc]
+external fp_backtrace : string -> unit = "fp_backtrace" [@@noalloc]
external c_fun : unit -> int = "c_fun"
let[@inline never][@local never] f x = x
@@ -42,7 +42,7 @@ let[@inline never] consume_stack () =
let[@inline never] callback () =
consume_stack ();
- fp_backtrace ();
+ fp_backtrace Sys.argv.(0);
0
let _ = Callback.register "callback" callback
diff --git a/testsuite/tests/frame-pointers/stack_realloc.reference b/testsuite/tests/frame-pointers/stack_realloc.reference
index 016a03550a..e61d4104e0 100644
--- a/testsuite/tests/frame-pointers/stack_realloc.reference
+++ b/testsuite/tests/frame-pointers/stack_realloc.reference
@@ -7,6 +7,3 @@ camlStack_realloc.f_comp
caml_runstack
camlStack_realloc.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
diff --git a/testsuite/tests/frame-pointers/stack_realloc.run b/testsuite/tests/frame-pointers/stack_realloc.run
deleted file mode 100644
index e96b5ea13a..0000000000
--- a/testsuite/tests/frame-pointers/stack_realloc.run
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/sh
-
-${program} 2>&1 \
- | ${test_source_directory}/filter-locations.sh ${program} >${output}
diff --git a/testsuite/tests/frame-pointers/stack_realloc2.ml b/testsuite/tests/frame-pointers/stack_realloc2.ml
index a3d21bf2bf..218dd6a1c3 100644
--- a/testsuite/tests/frame-pointers/stack_realloc2.ml
+++ b/testsuite/tests/frame-pointers/stack_realloc2.ml
@@ -13,7 +13,7 @@ open Effect.Deep
type _ t += E : int -> int t
-external fp_backtrace : unit -> unit = "fp_backtrace" [@@noalloc]
+external fp_backtrace : string -> unit = "fp_backtrace" [@@noalloc]
external c_fun : unit -> int = "c_fun"
let[@inline never][@local never] f x = x
@@ -41,7 +41,7 @@ let[@inline never] consume_stack () =
ignore (gobbler count)
let[@inline never] callback () =
- fp_backtrace ();
+ fp_backtrace Sys.argv.(0);
0
let _ = Callback.register "callback" callback
diff --git a/testsuite/tests/frame-pointers/stack_realloc2.reference b/testsuite/tests/frame-pointers/stack_realloc2.reference
index ae492abd88..0051f3bad0 100644
--- a/testsuite/tests/frame-pointers/stack_realloc2.reference
+++ b/testsuite/tests/frame-pointers/stack_realloc2.reference
@@ -7,6 +7,3 @@ camlStack_realloc2.f_comp
caml_runstack
camlStack_realloc2.entry
caml_program
-caml_start_program
-caml_main/caml_startup
-main
diff --git a/testsuite/tests/frame-pointers/stack_realloc2.run b/testsuite/tests/frame-pointers/stack_realloc2.run
deleted file mode 100644
index e96b5ea13a..0000000000
--- a/testsuite/tests/frame-pointers/stack_realloc2.run
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/sh
-
-${program} 2>&1 \
- | ${test_source_directory}/filter-locations.sh ${program} >${output}
--
2.43.0

26
0004-Fix-s390x-stack-reallocation-code-in-PIC-mode.patch
View File

@ -1,26 +0,0 @@
From 81d3fb3e20afede32298e4d3e78bcebf6a22858a Mon Sep 17 00:00:00 2001
From: Vincent Laviron <vincent.laviron@gmail.com>
Date: Fri, 15 Dec 2023 10:00:52 +0100
Subject: [PATCH 4/4] Fix s390x stack reallocation code in PIC mode
(cherry picked from commit c40a955c029a203d0d7f05718e297e66987ec87f)
---
asmcomp/s390x/emit.mlp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/asmcomp/s390x/emit.mlp b/asmcomp/s390x/emit.mlp
index 35ade079f6..0212cf3b00 100644
--- a/asmcomp/s390x/emit.mlp
+++ b/asmcomp/s390x/emit.mlp
@@ -751,7 +751,7 @@ let fundecl fundecl =
` lay %r15, -8(%r15)\n`;
` stg %r14, 0(%r15)\n`;
` lgfi %r12, {emit_int s}\n`;
- ` brasl %r14, {emit_symbol "caml_call_realloc_stack"}\n`;
+ emit_call "caml_call_realloc_stack";
` lg %r14, 0(%r15)\n`;
` la %r15, 8(%r15)\n`;
` brcl 15, {emit_label ret}\n`
--
2.43.0

27
ocaml.spec
View File

@ -42,16 +42,17 @@ ExcludeArch: %{ix86}
%global rcver %{nil}
Name: ocaml
Version: 5.1.1
Release: 4%{?dist}
Version: 5.2.0
Release: 1%{?dist}
Summary: OCaml compiler and programming environment
License: LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception
URL: https://www.ocaml.org
VCS: https://github.com/ocaml/ocaml
Source0: https://github.com/ocaml/ocaml/archive/%{version}/%{name}-%{version}.tar.gz
Source0: %{vcs}/archive/%{version}%{rcver}/%{name}-%{version}%{rcver}.tar.gz
Source1: macros.ocaml-rpm
Source2: ocaml_files.py
@ -74,13 +75,6 @@ Source2: ocaml_files.py
Patch: 0001-Don-t-add-rpaths-to-libraries.patch
Patch: 0002-configure-Allow-user-defined-C-compiler-flags.patch
# https://github.com/ocaml/ocaml/pull/11594
Patch: 0003-Update-framepointers-tests-to-avoid-false-positive-w.patch
# https://github.com/ocaml/ocaml/issues/12829
# https://github.com/ocaml/ocaml/pull/12831
Patch: 0004-Fix-s390x-stack-reallocation-code-in-PIC-mode.patch
BuildRequires: make
BuildRequires: git
BuildRequires: gcc
@ -111,8 +105,8 @@ Requires: ocaml-runtime%{?_isa} = %{version}-%{release}
# Force ocaml-srpm-macros to be at the latest version, both for builds
# and installs, since OCaml 5.1 has a different set of native code
# generators than previous versions.
BuildRequires: ocaml-srpm-macros >= 9
Requires: ocaml-srpm-macros >= 9
BuildRequires: ocaml-srpm-macros >= 10
Requires: ocaml-srpm-macros >= 10
# Bundles an MD5 implementation in runtime/caml/md5.h and runtime/md5.c
Provides: bundled(md5-plumb)
@ -368,8 +362,6 @@ hardlink -t $RPM_BUILD_ROOT%{_libdir}/ocaml/stublibs
%{_bindir}/ocamloptp
%endif
%{_libdir}/ocaml/camlheader
%{_libdir}/ocaml/camlheader_ur
%{_libdir}/ocaml/expunge
%{_libdir}/ocaml/ld.conf
%{_libdir}/ocaml/Makefile.config
@ -410,8 +402,6 @@ hardlink -t $RPM_BUILD_ROOT%{_libdir}/ocaml/stublibs
%{_libdir}/ocaml/*.cmo
%{_libdir}/ocaml/*.cmi
%{_libdir}/ocaml/*.cma
%{_libdir}/ocaml/camlheaderd
%{_libdir}/ocaml/camlheaderi
%{_libdir}/ocaml/stublibs
%dir %{_libdir}/ocaml/dynlink
%{_libdir}/ocaml/dynlink/META
@ -424,6 +414,7 @@ hardlink -t $RPM_BUILD_ROOT%{_libdir}/ocaml/stublibs
%{_libdir}/ocaml/runtime_events/META
%{_libdir}/ocaml/runtime_events/*.cmi
%{_libdir}/ocaml/runtime_events/*.cma
%{_libdir}/ocaml/runtime-launch-info
%{_libdir}/ocaml/stdlib
%dir %{_libdir}/ocaml/str
%{_libdir}/ocaml/str/META
@ -470,6 +461,10 @@ hardlink -t $RPM_BUILD_ROOT%{_libdir}/ocaml/stublibs
%changelog
* Thu May 23 2024 Jerry James <loganjerry@gmail.com> - 5.2.0-1
- Version 5.2.0
- Drop upstreamed frame pointer and s390x patches
* Thu Jan 25 2024 Fedora Release Engineering <releng@fedoraproject.org> - 5.1.1-4
- Rebuilt for https://fedoraproject.org/wiki/Fedora_40_Mass_Rebuild

2
sources
View File

@ -1 +1 @@
SHA512 (ocaml-5.1.1.tar.gz) = e4aa78afc9a59f604881f14093f4298ebcb005daeb8132a076fe6d24fdf8b59132cbfa2cfe677f1db1891351d3d637c621f24077e531cac6753c264fc7f5fbea
SHA512 (ocaml-5.2.0.tar.gz) = 78115690186c13c1f2480e4812a9fe34cce2c28bf8a89d5c9810bca0391f930cecd9cee2b53daca8a32da1815628b33be68f3948f1ad03fa50b72b14e3ea84f2