fix(P1 #35b): cache Qt shim ABI validation as a one-shot fast path
ober
4e5bb7a7a9e77016db10ff1c4bf20cf1a94cce64
--- a/lib/jerboa-qt/ffi.sls +++ b/lib/jerboa-qt/ffi.sls @@ -676,7 +676,7 @@ ffi-qt-scintilla-on-save-point-reached ffi-qt-scintilla-on-save-point-left ffi-qt-scintilla-on-margin-clicked - ffi-qt-scintilla-on-modified) + ffi-qt-scintilla-on-modified ffi-qt-abi-validation-count) (import (except (chezscheme) make-hash-table hash-table? sort sort! printf fprintf format path-extension path-absolute? @@ -706,6 +706,7 @@ "dylib" "so"))) (def *native-loaded?* #f) + (def *abi-validation-count* 0) (def \x2B;qt-shim-abi-version+ 1246843953) (def (load-configured-library! who path) (guard (e @@ -731,6 +732,7 @@ (foreign-entry? "jerboa_qt_application_create") (foreign-entry? "jerboa_qt_next_callback_event"))) (def (require-compatible-native!) + (set! *abi-validation-count* (+ *abi-validation-count* 1)) (unless (foreign-entry? "jerboa_qt_abi_version") (error 'jerboa-qt "Qt shim ABI canary is unavailable")) (let ([version ((foreign-procedure "jerboa_qt_abi_version" @@ -748,8 +750,11 @@ #t) (def (try-load-native!) (cond - [(native-provider-visible?) (require-compatible-native!)] [*native-loaded?* #t] + [(native-provider-visible?) + (require-compatible-native!) + (set! *native-loaded?* #t) + #t] [(native-loader-privileged?) #f] [else (native-loader-require-clean-environment! 'jerboa-qt) @@ -772,6 +777,7 @@ (unless (try-load-native!) (error who "unable to load Qt native libraries")) #t) + (def (ffi-qt-abi-validation-count) *abi-validation-count*) (def (string-contains-nul? s) (let loop ([i 0]) (and (< i (string-length s)) --- a/qt-test.ss +++ b/qt-test.ss @@ -8,6 +8,7 @@ (only (std misc thread) spawn thread-join!) (only (chezscheme) collect collect-maximum-generation current-time time-second time-nanosecond) + (only (jerboa-qt ffi) ffi-qt-abi-validation-count) (jerboa-qt qt)) (define *pass* 0) @@ -930,6 +931,25 @@ (format "GC did not run during blocking call; elapsed=~a ms" elapsed-ms)))))) +(test-group "P1 #35(b) native ABI fast path" + (test-case "ABI validation count is 1 after first FFI call" + ;; test-app (qt-app-create) above already triggered the first load, so + ;; the ABI validation count must be exactly 1, not N. + (check (ffi-qt-abi-validation-count) => 1)) + + (test-case "ABI validation count stays 1 across subsequent FFI calls" + ;; Exercise a handful of additional FFI entries; none should re-enter + ;; require-compatible-native! because *native-loaded?* short-circuits. + (let ([label (qt-label-create "probe")]) + (qt-label-set-text! label "1") + (qt-label-set-text! label "2") + (qt-label-set-text! label "3") + (qt-widget-set-tooltip! label "tip") + (qt-widget-set-enabled! label 0) + (qt-widget-set-enabled! label 1) + (destroy-widget! label)) + (check (ffi-qt-abi-validation-count) => 1))) + ;; ----------------------------------------------------------------- ;; Summary --- a/scripts/p1-regression-guard.sh +++ b/scripts/p1-regression-guard.sh @@ -48,6 +48,21 @@ echo "P1 #35(a) define-qt-ffi-blocking uses __collect_safe:" check_pattern "macro expands to foreign-procedure __collect_safe" \ 'foreign-procedure __collect_safe' +echo +echo "P1 #35(b) try-load-native! fast path checks *native-loaded?* first:" +# The first cond clause must be *native-loaded?* — match the literal form. +check_pattern "*native-loaded?* is the first cond clause" \ + '[*native-loaded?* #t]' + +echo +echo "P1 #35(b) ABI validation is counted for the regression guard:" +check_pattern "*abi-validation-count* counter exists" \ + '(def *abi-validation-count* 0)' +check_pattern "require-compatible-native! bumps the counter" \ + '(set! *abi-validation-count*' +check_pattern "ffi-qt-abi-validation-count accessor exists" \ + '(def (ffi-qt-abi-validation-count)' + if [ "$fail" -ne 0 ]; then echo "p1 regression guard: FAIL" >&2 exit 1 --- a/src/jerboa-qt/ffi.ss +++ b/src/jerboa-qt/ffi.ss @@ -785,7 +785,10 @@ ffi-qt-scintilla-set-focus ffi-qt-scintilla-on-text-changed ffi-qt-scintilla-on-char-added ffi-qt-scintilla-on-save-point-reached ffi-qt-scintilla-on-save-point-left - ffi-qt-scintilla-on-margin-clicked ffi-qt-scintilla-on-modified) + ffi-qt-scintilla-on-margin-clicked ffi-qt-scintilla-on-modified + + ;; Loader introspection (P1 #35 regression guards) + ffi-qt-abi-validation-count) (import (jerboa prelude) (only (jerboa ffi) c-lambda load-shared-object*) @@ -812,6 +815,7 @@ "so"))) (def *native-loaded?* #f) + (def *abi-validation-count* 0) (def +qt-shim-abi-version+ #x4a515431) ; JQT1 (def (load-configured-library! who path) @@ -839,6 +843,7 @@ (foreign-entry? "jerboa_qt_next_callback_event"))) (def (require-compatible-native!) + (set! *abi-validation-count* (+ *abi-validation-count* 1)) (unless (foreign-entry? "jerboa_qt_abi_version") (error 'jerboa-qt "Qt shim ABI canary is unavailable")) (let ([version @@ -854,9 +859,11 @@ (def (try-load-native!) (cond - [(native-provider-visible?) - (require-compatible-native!)] [*native-loaded?* #t] + [(native-provider-visible?) + (require-compatible-native!) + (set! *native-loaded?* #t) + #t] [(native-loader-privileged?) #f] [else ;; Static symbols are checked first. A dynamic development load is @@ -882,6 +889,8 @@ (error who "unable to load Qt native libraries")) #t) + (def (ffi-qt-abi-validation-count) *abi-validation-count*) + (def (string-contains-nul? s) (let loop ([i 0]) (and (< i (string-length s)) --- a/tests/pure.ss +++ b/tests/pure.ss @@ -70,6 +70,12 @@ (check-pred "ffi-qt-color-dialog-get-color is procedure" ffi-qt-color-dialog-get-color procedure?) +(format #t "~%=== P1 #35(b): native ABI fast-path guard ===~%") +(check-pred "ffi-qt-abi-validation-count is procedure" + ffi-qt-abi-validation-count procedure?) +(check-equal "abi validation count starts at zero before any FFI call" + (ffi-qt-abi-validation-count) 0) + (format #t "~%=== Results ===~%") (format #t "~a tests, ~a passed, ~a failed~%~%" test-count pass-count fail-count)