of_string accepts underscores when parsing strings

caml_z.c

@@ -583,7 +583,7 @@ CAMLprim value ml_z_of_substring_base(value b, value v, value offset, value leng
   /* process the string */
   const char *d = String_val(v) + ofs;
   const char *end = d + len;
-  mp_size_t i, sz, sz2;
+  mp_size_t i, j, sz, sz2;
   mp_limb_t sign = 0;
   intnat base = Long_val(b);
   /* We allow [d] to advance beyond [end] while parsing the prefix:
@@ -624,6 +624,8 @@ CAMLprim value ml_z_of_substring_base(value b, value v, value offset, value leng
       intnat ret = 0;
       for (i = 0; i < sz; i++) {
         int digit = 0;
+        /* skip underscores but leading ones */
+        if (i > 0 && d[i] == '_') continue;
         if (d[i] >= '0' && d[i] <= '9') digit = d[i] - '0';
         else if (d[i] >= 'a' && d[i] <= 'f') digit = d[i] - 'a' + 10;
         else if (d[i] >= 'A' && d[i] <= 'F') digit = d[i] - 'A' + 10;
@@ -638,19 +640,20 @@ CAMLprim value ml_z_of_substring_base(value b, value v, value offset, value leng
   {
      /* converts to sequence of digits */
     char* dd = (char*)malloc(sz+1);
-    strncpy(dd,d,sz);
-    /* make sure that dd is nul terminated */
-    dd[sz] = 0;
-    for (i = 0; i < sz; i++) {
-      if (dd[i] >= '0' && dd[i] <= '9') dd[i] -= '0';
-      else if (dd[i] >= 'a' && dd[i] <= 'f') dd[i] -= 'a' - 10;
-      else if (dd[i] >= 'A' && dd[i] <= 'F') dd[i] -= 'A' - 10;
-      else caml_invalid_argument("Z.of_substring_base: invalid digit");
-      if (dd[i] >= base)
-        caml_invalid_argument("Z.of_substring_base: invalid digit");
+    for (i = 0, j = 0; i < sz; i++, j++) {
+      /* skip underscores but leading ones */
+      if (i > 0 && d[i] == '_') {j--;continue;};
+      if (d[i] >= '0' && d[i] <= '9') dd[j] = d[i] - '0';
+      else if (d[i] >= 'a' && d[i] <= 'f') dd[j] = d[i] - 'a' + 10;
+      else if (d[i] >= 'A' && d[i] <= 'F') dd[j] = d[i] - 'A' + 10;
+      else caml_invalid_argument("Z.of_substring_base: invalid digit1");
+      if (dd[j] >= base)
+        caml_invalid_argument("Z.of_substring_base: invalid digit2");
     }
-    r = ml_z_alloc(1 + sz / (2 * sizeof(mp_limb_t)));
-    sz2 = mpn_set_str(Z_LIMB(r), (unsigned char*)dd, sz, base);
+    /* make sure that dd is nul terminated */
+    dd[j] = 0;
+    r = ml_z_alloc(1 + j / (2 * sizeof(mp_limb_t)));
+    sz2 = mpn_set_str(Z_LIMB(r), (unsigned char*)dd, j, base);
     r = ml_z_reduce(r, sz2, sign);
     free(dd);
   }

tests/ofstring.ml

@@ -152,18 +152,31 @@ let test_of_string_Q () =
                     (Printexc.to_string exc)
   in
   let z_and_float_agree s =
-    let a = Q.of_float (float_of_string s) in
-    let b = Q.of_string s in
-    if Q.equal a b
-    then ()
-    else
-      Printf.printf
+    let f = try Some (float_of_string s) with _ -> None in
+    let q = try Some (Q.of_string s) with _ -> None in
+    match f,q with
+    | None, None -> ()
+    | Some f, Some q ->
+      if not (Q.equal (Q.of_float f) q)
+      then
+        Printf.printf
         "Q.of_string (%s) returned %s, expected %s\n"
         s
-        (Q.to_string b)
-        (Q.to_string a)
+        (Q.to_string q)
+        (string_of_float f)
+    | Some f, None ->
+      Printf.printf
+        "Q.of_string (%s) failed, expected %s\n"
+        s
+        (string_of_float f)
+    | None, Some q ->
+      Printf.printf
+        "Q.of_string (%s) returned %s, failure expected"
+        s
+        (Q.to_string q)
   in
 
+
   round_trip_Q ();
 
   fail "Q.of_string" Q.of_string "0b2";
@@ -214,6 +227,15 @@ let test_of_string_Q () =
   z_and_float_agree "-0x0.1p1" ;
   z_and_float_agree "-0x0.1P1" ;
   z_and_float_agree "-0x0.1p10" ;
-  z_and_float_agree "-0x0.1p10"
+  z_and_float_agree "-0x0.1p10" ;
+
+  z_and_float_agree "1_2.34e03";
+  z_and_float_agree "12_.34e03";
+  z_and_float_agree "12._34e03";
+  z_and_float_agree "12.3_4e03";
+  z_and_float_agree "12.34_e03";
+  z_and_float_agree "12.34e_03";
+  z_and_float_agree "12.34e0_3";
+  z_and_float_agree "12.34e03_"
 
 let _ = test_of_string_Q ()