From 7967f0f8966db8ea22644554277a9bade43d3641 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 17 Jan 2012 13:02:18 +0000 Subject: [PATCH 1/1] In a '{...} as foo' binding, save the original bitstring offset and length as 'foo'. Before we were saving the running offset and length. This commit also adds a regression test. (Bug found by Matej Kosik). --- pa_bitstring.ml | 3 ++- tests/test_90_bind_as.ml | 18 ++++++++++++++++++ 2 files changed, 20 insertions(+), 1 deletion(-) create mode 100644 tests/test_90_bind_as.ml diff --git a/pa_bitstring.ml b/pa_bitstring.ml index 1414612..58fe1ed 100644 --- a/pa_bitstring.ml +++ b/pa_bitstring.ml @@ -989,7 +989,8 @@ let output_bitmatch _loc bs cases = match bind with | Some name -> <:expr< - let $lid:name$ = ($lid:data$, $lid:off$, $lid:len$) in + let $lid:name$ = ($lid:data$, + $lid:original_off$, $lid:original_len$) in $inner$ >> | None -> inner in diff --git a/tests/test_90_bind_as.ml b/tests/test_90_bind_as.ml new file mode 100644 index 0000000..a83d7ce --- /dev/null +++ b/tests/test_90_bind_as.ml @@ -0,0 +1,18 @@ +(* Regression test for bug in 'as-binding' found by Matej Kosik. + * $Id$ + *) + +open Printf +open Bitstring + +let bits = Bitstring.ones_bitstring 1 in +bitmatch bits with +| { _ : 1 } as foo -> + let len = Bitstring.bitstring_length foo in + if len <> 1 then ( + hexdump_bitstring stderr foo; + eprintf "test error: length = %d, expecting 1\n" len; + exit 1 + ) +| { _ } -> + assert false -- 1.8.3.1