neovm-core 0.0.2

Core runtime structures for NeoVM
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130

mod common;

use common::{oracle_enabled, run_neovm_eval, run_oracle_eval};

fn run_case(name: &str, form: &str) {
    if !oracle_enabled() {
        eprintln!(
            "skipping advice stack audit: set NEOVM_FORCE_ORACLE_PATH or place GNU Emacs mirror alongside the repo"
        );
        return;
    }

    let gnu = run_oracle_eval(form).expect("GNU Emacs evaluation");
    let neovm = run_neovm_eval(form).expect("NeoVM evaluation");
    assert_eq!(
        neovm, gnu,
        "advice stack semantics mismatch for {}:\nGNU: {}\nNeoVM: {}",
        name, gnu, neovm
    );
}

#[test]
fn compat_backtrace_frame_marks_funcall_interactively_matches_gnu_emacs() {
    run_case(
        "backtrace_frame_marks_funcall_interactively",
        r#"
(progn
  (defun compat--bt-marker-target ()
    (interactive)
    (nth 1 (backtrace-frame 1 'compat--bt-marker-target)))
  (unwind-protect
      (list
       (funcall-interactively 'compat--bt-marker-target)
       (call-interactively 'compat--bt-marker-target))
    (fmakunbound 'compat--bt-marker-target)))
"#,
    );
}

#[test]
fn compat_advised_called_interactively_p_matches_gnu_emacs() {
    run_case(
        "advised_called_interactively_p",
        r#"
(progn
  (defun compat--advice-ci-target ()
    (interactive)
    (list (called-interactively-p 'any)
          (called-interactively-p 'interactive)))
  (defun compat--advice-ci-around (orig &rest args)
    (apply orig args))
  (advice-add 'compat--advice-ci-target :around 'compat--advice-ci-around)
  (unwind-protect
      (list
       (funcall-interactively 'compat--advice-ci-target)
       (call-interactively 'compat--advice-ci-target))
    (advice-remove 'compat--advice-ci-target 'compat--advice-ci-around)
    (fmakunbound 'compat--advice-ci-around)
    (fmakunbound 'compat--advice-ci-target)))
"#,
    );
}

#[test]
fn compat_around_advice_stack_shape_matches_gnu_emacs() {
    run_case(
        "around_advice_stack_shape",
        r#"
(progn
  (defun compat--advice-stack-target ()
    (interactive)
    (list 'target
          (called-interactively-p 'any)
          (called-interactively-p 'interactive)
          (nth 1 (backtrace-frame 1 'compat--advice-stack-target))))
  (defun compat--advice-stack-around (orig &rest args)
    (list 'around-enter
          (called-interactively-p 'any)
          (called-interactively-p 'interactive)
          (nth 1 (backtrace-frame 1 'compat--advice-stack-around))
          (apply orig args)))
  (advice-add 'compat--advice-stack-target :around 'compat--advice-stack-around)
  (unwind-protect
      (list
       (funcall-interactively 'compat--advice-stack-target)
       (call-interactively 'compat--advice-stack-target))
    (advice-remove 'compat--advice-stack-target 'compat--advice-stack-around)
    (fmakunbound 'compat--advice-stack-around)
    (fmakunbound 'compat--advice-stack-target)))
"#,
    );
}

#[test]
fn compat_before_advice_stack_shape_matches_gnu_emacs() {
    run_case(
        "before_advice_stack_shape",
        r#"
(progn
  (defvar compat--advice-stack-before-result nil)
  (defun compat--advice-stack-target ()
    (interactive)
    (list 'target
          (called-interactively-p 'any)
          (called-interactively-p 'interactive)
          (nth 1 (backtrace-frame 1 'compat--advice-stack-target))))
  (defun compat--advice-stack-before (&rest _args)
    (setq compat--advice-stack-before-result
          (list 'before
                (called-interactively-p 'any)
                (called-interactively-p 'interactive)
                (nth 1 (backtrace-frame 1 'compat--advice-stack-before)))))
  (advice-add 'compat--advice-stack-target :before 'compat--advice-stack-before)
  (unwind-protect
      (list
       (list
        (funcall-interactively 'compat--advice-stack-target)
        compat--advice-stack-before-result)
       (progn
         (setq compat--advice-stack-before-result nil)
         (list
          (call-interactively 'compat--advice-stack-target)
          compat--advice-stack-before-result)))
    (advice-remove 'compat--advice-stack-target 'compat--advice-stack-before)
    (fmakunbound 'compat--advice-stack-before)
    (fmakunbound 'compat--advice-stack-target)
    (makunbound 'compat--advice-stack-before-result)))
"#,
    );
}