Skip to content

fix(stdune): enforce compact position field bounds #16180

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
rgrinberg merged 1 commit into from
Aug 25, 2026
+7 −23
Merged

fix(stdune): enforce compact position field bounds #16180

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions doc/changes/fixed/16180.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
- Prevent diagnostic source locations at compact-position field boundaries from
being truncated (#16180, @rgrinberg)
8 changes: 2 additions & 6 deletions otherlibs/stdune/src/compact_position.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,8 +9,7 @@ module Position = struct
let shift_cnum = 2 * field_size

let small_enough =
let max_size = 1 lsl field_size in
let test int = int <= max_size in
let test int = int >= 0 && int <= field_mask in
fun[@inline] { Lexing.pos_bol; pos_cnum; pos_lnum; pos_fname = _ } ->
test pos_bol && test pos_cnum && test pos_lnum
;;
Expand Down Expand Up @@ -73,10 +72,7 @@ module Same_line_loc = struct
create ~bol ~lnum ~start_cnum:stop_cnum ~stop_cnum
;;

let small_enough =
let max_size = 1 lsl field_size in
fun[@inline] int -> int <= max_size
;;
let[@inline] small_enough int = int >= 0 && int <= field_mask

let[@inline] to_loc t ~fname:pos_fname =
let pos_lnum = lnum t in
Expand Down
20 changes: 3 additions & 17 deletions otherlibs/stdune/test/compact_position_tests.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,23 +27,9 @@ let%expect_test "round trip tests" =
test { base with pos_cnum = (1 lsl 21) - 1; pos_lnum = 2_200; pos_bol = 300 };
[%expect {| [PASS] |}];
test { base with pos_cnum = 1 lsl 21; pos_lnum = 2_200; pos_bol = 300 };
[%expect
{|
[FAIL]
expected:
{ pos_lnum = 2200; pos_bol = 300; pos_cnum = 2097152 }
received:
{ pos_lnum = 2200; pos_bol = 300; pos_cnum = 0 }
|}];
[%expect {| position too large |}];
test { base with pos_cnum = -1; pos_lnum = 2_200; pos_bol = 300 };
[%expect
{|
[FAIL]
expected:
{ pos_lnum = 2200; pos_bol = 300; pos_cnum = -1 }
received:
{ pos_lnum = 2200; pos_bol = 300; pos_cnum = 2097151 }
|}];
[%expect {| position too large |}];
test { base with pos_cnum = 1 lsl 32; pos_lnum = 2_200; pos_bol = 300 };
[%expect {| position too large |}]
;;
Expand All @@ -55,5 +41,5 @@ let%expect_test "same-line locations at the field boundary" =
| Same_line _ -> print_endline "same-line encoding overflowed"
| Loc _ -> print_endline "used the wider encoding"
| Loc_does_not_fit -> print_endline "location does not fit");
[%expect {| same-line encoding overflowed |}]
[%expect {| used the wider encoding |}]
;;
Loading