Reusable 3D Earth globe widget (pure OCaml + WebGL)
Add satellite fuzz tests (8 properties)
Fuzzes Globe.Satellite with random state vectors via alcobar:
1. No crash on any finite state vector
2. position_at returns finite values (bound orbits)
3. trail_positions returns finite values
4. Smoothness: consecutive frames jump < 5% of radius
5. Determinism: same dt → same position
6. Recreate stability: same params → same positions
7. Ghost points finite (bound orbits)
8. dot returns finite position + color
Guards skip unbound orbits (e >= 1) and extreme dt values.
+219
+21
fuzz/dune
+21
fuzz/dune
···
1
+
(executable
2
+
(name fuzz)
3
+
(modules fuzz fuzz_satellite)
4
+
(libraries globe alcobar))
5
+
6
+
(rule
7
+
(alias runtest)
8
+
(enabled_if (<> %{profile} afl))
9
+
(deps fuzz.exe)
10
+
(action
11
+
(run %{exe:fuzz.exe})))
12
+
13
+
(rule
14
+
(alias fuzz)
15
+
(enabled_if
16
+
(= %{profile} afl))
17
+
(deps
18
+
(source_tree corpus)
19
+
fuzz.exe)
20
+
(action
21
+
(echo "AFL fuzzer built: %{exe:fuzz.exe}\n")))
+1
fuzz/fuzz.ml
+1
fuzz/fuzz.ml
···
1
+
let () = Alcobar.run "globe" [Fuzz_satellite.suite]
+196
fuzz/fuzz_satellite.ml
+196
fuzz/fuzz_satellite.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Fuzz tests for Globe.Satellite.
7
+
8
+
Properties:
9
+
1. Satellite.v never crashes on valid (finite) state vectors
10
+
2. position_at never produces NaN/infinity
11
+
3. trail_positions never produces NaN/infinity
12
+
4. Consecutive small dt steps produce small position changes (smoothness)
13
+
5. Same dt always produces same position (determinism) *)
14
+
15
+
open Alcobar
16
+
open Globe
17
+
18
+
let is_finite f = Float.is_finite f && not (Float.is_nan f)
19
+
20
+
let is_valid_vec3 (v : Math.Vec3.t) =
21
+
is_finite v.x && is_finite v.y && is_finite v.z
22
+
23
+
(** Read 6 finite floats from fuzz input as a state vector. *)
24
+
let read_state_vector buf =
25
+
let len = Bytes.length (Bytes.of_string buf) in
26
+
if len < 48 then None
27
+
else
28
+
let b = Bytes.of_string buf in
29
+
let get i = Int64.float_of_bits (Bytes.get_int64_le b (i * 8)) in
30
+
let px = get 0 and py = get 1 and pz = get 2 in
31
+
let vx = get 3 and vy = get 4 and vz = get 5 in
32
+
if is_finite px && is_finite py && is_finite pz
33
+
&& is_finite vx && is_finite vy && is_finite vz
34
+
(* Skip degenerate cases: zero position or zero velocity *)
35
+
&& (px *. px +. py *. py +. pz *. pz) > 1e-10
36
+
&& (vx *. vx +. vy *. vy +. vz *. vz) > 1e-10
37
+
then
38
+
Some (Kepler.Vec3.v px py pz, Kepler.Vec3.v vx vy vz)
39
+
else None
40
+
41
+
(** 1. Satellite.v must not crash on any valid state vector. *)
42
+
let test_no_crash buf =
43
+
match read_state_vector buf with
44
+
| None -> ()
45
+
| Some (pos, vel) ->
46
+
let _sat = Satellite.v ~pos ~vel ~color:Color.cyan () in
47
+
()
48
+
49
+
(** 2. position_at must not produce NaN/infinity for any dt.
50
+
Only test bound orbits (period > 0, eccentricity < 1). *)
51
+
let test_position_finite buf n =
52
+
match read_state_vector buf with
53
+
| None -> ()
54
+
| Some (pos, vel) ->
55
+
let sat = Satellite.v ~pos ~vel ~color:Color.cyan () in
56
+
let period = Satellite.period sat in
57
+
(* Skip unbound orbits — Kepler equation only valid for e < 1 *)
58
+
if not (is_finite period) || period <= 0. then ()
59
+
else
60
+
let dt = Float.of_int n *. 10. in
61
+
if is_finite dt && abs_float dt < period *. 100. then begin
62
+
let p = Satellite.position_at sat ~dt in
63
+
assert (is_valid_vec3 p)
64
+
end
65
+
66
+
(** 3. trail_positions must not produce NaN/infinity. *)
67
+
let test_trail_finite buf n =
68
+
match read_state_vector buf with
69
+
| None -> ()
70
+
| Some (pos, vel) ->
71
+
let sat = Satellite.v ~pos ~vel ~color:Color.cyan () in
72
+
let period = Satellite.period sat in
73
+
if not (is_finite period) || period <= 0. then ()
74
+
else
75
+
let dt = Float.of_int n *. 10. in
76
+
if is_finite dt && abs_float dt < period *. 100. then begin
77
+
let trail = Satellite.trail_positions sat ~dt in
78
+
Array.iter (fun p ->
79
+
match p with
80
+
| None -> assert false
81
+
| Some v -> assert (is_valid_vec3 v))
82
+
trail
83
+
end
84
+
85
+
(** 4. Smoothness: consecutive frames must not jump more than threshold.
86
+
Uses fuzz input to pick random state vector, then simulates 100 frames. *)
87
+
let test_smooth buf =
88
+
match read_state_vector buf with
89
+
| None -> ()
90
+
| Some (pos, vel) ->
91
+
let sat = Satellite.v ~pos ~vel ~color:Color.cyan () in
92
+
let period = Satellite.period sat in
93
+
if not (is_finite period) || period < 1. then ()
94
+
else begin
95
+
(* Frame step: 1/60th of period at 100x speed *)
96
+
let frame_dt = period /. 60. in
97
+
let prev = ref (Satellite.position_at sat ~dt:0.) in
98
+
for frame = 1 to 100 do
99
+
let dt = Float.of_int frame *. frame_dt in
100
+
let p = Satellite.position_at sat ~dt in
101
+
if is_valid_vec3 p && is_valid_vec3 !prev then begin
102
+
let dx = p.x -. !prev.x in
103
+
let dy = p.y -. !prev.y in
104
+
let dz = p.z -. !prev.z in
105
+
let jump = sqrt (dx *. dx +. dy *. dy +. dz *. dz) in
106
+
(* Max jump per frame: 5% of orbital radius *)
107
+
let radius = Math.Vec3.length !prev in
108
+
let max_jump = Float.max 0.1 (radius *. 0.05) in
109
+
assert (jump < max_jump)
110
+
end;
111
+
prev := p
112
+
done
113
+
end
114
+
115
+
(** 5. Determinism: same dt must always produce same position. *)
116
+
let test_deterministic buf n =
117
+
match read_state_vector buf with
118
+
| None -> ()
119
+
| Some (pos, vel) ->
120
+
let sat = Satellite.v ~pos ~vel ~color:Color.cyan () in
121
+
let period = Satellite.period sat in
122
+
if not (is_finite period) || period <= 0. then ()
123
+
else
124
+
let dt = Float.of_int n *. 10. in
125
+
if is_finite dt && abs_float dt < period *. 100. then begin
126
+
let p1 = Satellite.position_at sat ~dt in
127
+
let p2 = Satellite.position_at sat ~dt in
128
+
assert (p1.x = p2.x);
129
+
assert (p1.y = p2.y);
130
+
assert (p1.z = p2.z)
131
+
end
132
+
133
+
(** 6. Recreate stability: same params must produce same positions. *)
134
+
let test_recreate_stable buf n =
135
+
match read_state_vector buf with
136
+
| None -> ()
137
+
| Some (pos, vel) ->
138
+
let epoch = 1735732800. in
139
+
let s1 = Satellite.v ~pos ~vel ~color:Color.cyan ~epoch_unix:epoch () in
140
+
let s2 = Satellite.v ~pos ~vel ~color:Color.cyan ~epoch_unix:epoch () in
141
+
let period = Satellite.period s1 in
142
+
if not (is_finite period) || period <= 0. then ()
143
+
else
144
+
let dt = Float.of_int n *. 10. in
145
+
if is_finite dt && abs_float dt < period *. 100. then begin
146
+
let p1 = Satellite.position_at s1 ~dt in
147
+
let p2 = Satellite.position_at s2 ~dt in
148
+
assert (p1.x = p2.x);
149
+
assert (p1.y = p2.y);
150
+
assert (p1.z = p2.z)
151
+
end
152
+
153
+
(** 7. Ghost points must all be finite for bound orbits. *)
154
+
let test_ghost_finite buf =
155
+
match read_state_vector buf with
156
+
| None -> ()
157
+
| Some (pos, vel) ->
158
+
let sat = Satellite.v ~pos ~vel ~color:Color.cyan () in
159
+
let period = Satellite.period sat in
160
+
if not (is_finite period) || period <= 0. then ()
161
+
else
162
+
let ghost = Satellite.ghost_points sat in
163
+
Array.iter (fun p ->
164
+
match p with
165
+
| None -> assert false
166
+
| Some v -> assert (is_valid_vec3 v))
167
+
ghost
168
+
169
+
(** 8. dot must return finite position and valid color. *)
170
+
let test_dot_finite buf n =
171
+
match read_state_vector buf with
172
+
| None -> ()
173
+
| Some (pos, vel) ->
174
+
let sat = Satellite.v ~pos ~vel ~color:Color.cyan () in
175
+
let period = Satellite.period sat in
176
+
if not (is_finite period) || period <= 0. then ()
177
+
else
178
+
let dt = Float.of_int n *. 10. in
179
+
if is_finite dt && abs_float dt < period *. 100. then begin
180
+
let p, (r, g, b) = Satellite.dot sat ~dt in
181
+
assert (is_valid_vec3 p);
182
+
assert (is_finite r && is_finite g && is_finite b)
183
+
end
184
+
185
+
let suite =
186
+
( "satellite",
187
+
[
188
+
test_case "no crash" [bytes] test_no_crash;
189
+
test_case "position finite" [bytes; int] test_position_finite;
190
+
test_case "trail finite" [bytes; int] test_trail_finite;
191
+
test_case "smooth" [bytes] test_smooth;
192
+
test_case "deterministic" [bytes; int] test_deterministic;
193
+
test_case "recreate stable" [bytes; int] test_recreate_stable;
194
+
test_case "ghost finite" [bytes] test_ghost_finite;
195
+
test_case "dot finite" [bytes; int] test_dot_finite;
196
+
] )
+1
fuzz/fuzz_satellite.mli
+1
fuzz/fuzz_satellite.mli
···
1
+
val suite : string * Alcobar.test_case list