Fail when unmarshaling would produce non-canonical big integers

caml_z.c

@@ -3395,10 +3395,17 @@ static void ml_z_custom_serialize(value v,
 #endif
 }
 
-/* XXX: serializing a large (i.e., > 2^31) int on a 64-bit machine and
-   deserializing on a 32-bit machine will fail (instead of returning a
-   block).
- */
+/* There are two issues with integers that are tagged ints on a 64-bit
+   machine but boxed bigints on a 32-bit machine, namely integers in the
+   [2^30, 2^62) and [-2^62, -2^30) ranges:
+   - Serializing such an integer on a 64-bit machine and
+     deserializing on a 32-bit machine will fail in the generic unmarshaler.
+     The correct behavior would be to return a boxed integer.
+   - Serializing such an integer on a 32-bit machine and
+     deserializing on a 64-bit machine must fail.
+     The wrong behavior would be to return a block containing a
+     non-normalized, boxed integer (issue #148).
+*/
 static uintnat ml_z_custom_deserialize(void * dst)
 {
   mp_limb_t* d = ((mp_limb_t*)dst) + 1;
@@ -3444,6 +3451,14 @@ static uintnat ml_z_custom_deserialize(void * dst)
 #if Z_PERFORM_CHECK
   d[szw] = 0xDEADBEEF ^ szw;
   szw++;
+#endif
+#if Z_USE_NATINT
+  if (i == 0 ||
+      (i == 1 && (d[0] <= Z_MAX_INT || (d[0] == -Z_MIN_INT && sign)))) {
+    /* Issue #148: this is not a canonical representation,
+       so we raise a Failure */
+    caml_deserialize_error("Z.t value produced on a 32-bit platform cannot be read on a 64-bit platform");
+  }
 #endif
   return (szw+1) * sizeof(mp_limb_t);
 }

tests/Makefile

@@ -50,6 +50,14 @@ test:: tst_extract.exe
 	@echo "Testing extract..."
 	@if ./tst_extract.exe; then echo "tst_extract: passed"; else echo "tst_extract: FAILED"; exit 2; fi
 
+test:: intern.exe
+	@echo "Testing unmarshaling..."
+	@if ./intern.exe extern.data32 | cmp -s intern.output32$(WORDSIZE) -; then echo "intern 32: passed"; else echo "intern 32: failed"; exit 2; fi
+	@if ./intern.exe extern.data64 | cmp -s intern.output64$(WORDSIZE) -; then echo "intern 64: passed"; else echo "intern 64: failed"; exit 2; fi
+
+extern.data$(WORDSIZE): extern.exe
+	./extern.exe extern.data$(WORDSIZE)
+
 tofloat.exe: tofloat.ml setround.o ../zarith.cmxa
 	ocamlopt -I .. -ccopt "-L.." zarith.cmxa -o tofloat.exe \
            setround.o tofloat.ml

tests/extern.ml

@@ -0,0 +1,14 @@
+(* Marshal some interesting big integers to the given file *)
+
+let _ =
+  let file = Sys.argv.(1) in
+  let oc = open_out_bin file in
+  for nbits = 16 to 128 do
+    let x = Z.shift_left Z.one nbits in
+    output_value oc (Z.pred (Z.neg x));
+    output_value oc (Z.neg x);
+    output_value oc (Z.pred x);
+    output_value oc x
+  done;
+  close_out oc
+

tests/intern.ml

@@ -0,0 +1,24 @@
+(* Unmarshal big integers from the given file, and report errors *)
+
+open Printf
+
+let expect ic n =
+  try
+    let m = (input_value ic : Z.t) in
+    if Z.equal m n then printf " OK" else printf " Wrong"
+  with Failure _ ->
+    printf " Fail"
+
+let _ =
+  let file = Sys.argv.(1) in
+  let ic = open_in_bin file in
+  for nbits = 16 to 128 do
+    printf "%d:" nbits;
+    let x = Z.shift_left Z.one nbits in
+    expect ic (Z.pred (Z.neg x));
+    expect ic (Z.neg x);
+    expect ic (Z.pred x);
+    expect ic x;
+    print_newline()
+  done;
+  close_in ic

tests/intern.output3232

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

tests/intern.output3264

@@ -0,0 +1,113 @@
+16: OK OK OK OK
+17: OK OK OK OK
+18: OK OK OK OK
+19: OK OK OK OK
+20: OK OK OK OK
+21: OK OK OK OK
+22: OK OK OK OK
+23: OK OK OK OK
+24: OK OK OK OK
+25: OK OK OK OK
+26: OK OK OK OK
+27: OK OK OK OK
+28: OK OK OK OK
+29: OK OK OK OK
+30: Fail OK OK Fail
+31: Fail Fail Fail Fail
+32: Fail Fail Fail Fail
+33: Fail Fail Fail Fail
+34: Fail Fail Fail Fail
+35: Fail Fail Fail Fail
+36: Fail Fail Fail Fail
+37: Fail Fail Fail Fail
+38: Fail Fail Fail Fail
+39: Fail Fail Fail Fail
+40: Fail Fail Fail Fail
+41: Fail Fail Fail Fail
+42: Fail Fail Fail Fail
+43: Fail Fail Fail Fail
+44: Fail Fail Fail Fail
+45: Fail Fail Fail Fail
+46: Fail Fail Fail Fail
+47: Fail Fail Fail Fail
+48: Fail Fail Fail Fail
+49: Fail Fail Fail Fail
+50: Fail Fail Fail Fail
+51: Fail Fail Fail Fail
+52: Fail Fail Fail Fail
+53: Fail Fail Fail Fail
+54: Fail Fail Fail Fail
+55: Fail Fail Fail Fail
+56: Fail Fail Fail Fail
+57: Fail Fail Fail Fail
+58: Fail Fail Fail Fail
+59: Fail Fail Fail Fail
+60: Fail Fail Fail Fail
+61: Fail Fail Fail Fail
+62: OK Fail Fail OK
+63: OK OK OK OK
+64: OK OK OK OK
+65: OK OK OK OK
+66: OK OK OK OK
+67: OK OK OK OK
+68: OK OK OK OK
+69: OK OK OK OK
+70: OK OK OK OK
+71: OK OK OK OK
+72: OK OK OK OK
+73: OK OK OK OK
+74: OK OK OK OK
+75: OK OK OK OK
+76: OK OK OK OK
+77: OK OK OK OK
+78: OK OK OK OK
+79: OK OK OK OK
+80: OK OK OK OK
+81: OK OK OK OK
+82: OK OK OK OK
+83: OK OK OK OK
+84: OK OK OK OK
+85: OK OK OK OK
+86: OK OK OK OK
+87: OK OK OK OK
+88: OK OK OK OK
+89: OK OK OK OK
+90: OK OK OK OK
+91: OK OK OK OK
+92: OK OK OK OK
+93: OK OK OK OK
+94: OK OK OK OK
+95: OK OK OK OK
+96: OK OK OK OK
+97: OK OK OK OK
+98: OK OK OK OK
+99: OK OK OK OK
+100: OK OK OK OK
+101: OK OK OK OK
+102: OK OK OK OK
+103: OK OK OK OK
+104: OK OK OK OK
+105: OK OK OK OK
+106: OK OK OK OK
+107: OK OK OK OK
+108: OK OK OK OK
+109: OK OK OK OK
+110: OK OK OK OK
+111: OK OK OK OK
+112: OK OK OK OK
+113: OK OK OK OK
+114: OK OK OK OK
+115: OK OK OK OK
+116: OK OK OK OK
+117: OK OK OK OK
+118: OK OK OK OK
+119: OK OK OK OK
+120: OK OK OK OK
+121: OK OK OK OK
+122: OK OK OK OK
+123: OK OK OK OK
+124: OK OK OK OK
+125: OK OK OK OK
+126: OK OK OK OK
+127: OK OK OK OK
+128: OK OK OK OK