109.55.00

_oasis

@@ -2,7 +2,7 @@ OASISFormat:      0.3
 OCamlVersion:     >= 4.00.0
 FindlibVersion:   >= 1.3.2
 Name:             sexplib
-Version:          109.53.00
+Version:          109.55.00
 Synopsis:         sexplib - automated S-expression conversion
 Authors:          Jane Street Capital LLC <[email protected]>
 Copyrights:       (C) 2005-2013 Jane Street Capital LLC <[email protected]>

_tags

@@ -1,6 +1,6 @@
 # OASIS_START
 # OASIS_STOP
-<lib/pre_sexp.ml>: pp(cpp -undef -traditional -I/mnt/local/sda1/jdimino/git/sexplib/syntax)
+<lib/pre_sexp.ml>: pp(cpp -undef -traditional -Isyntax)
 <lib_test/*.ml{,i}>: syntax_camlp4o, pkg_type_conv.syntax
 <lib_test/conv_test.byte>: use_sexplib, pkg_unix, pkg_num, pkg_bigarray
 <syntax/pa_sexp_conv.ml>: syntax_camlp4o

lib/conv.ml

@@ -493,7 +493,7 @@ let of_string__of__of_sexp of_sexp s =
 (* Registering default exception printers *)
 
 let get_flc_error name (file, line, chr) =
-  List [Atom name; Atom file; sexp_of_int line; sexp_of_int chr]
+  Atom (sprintf "%s %s:%d:%d" name file line chr)
 
 let () =
   List.iter

lib/pre_sexp.ml

@@ -29,24 +29,65 @@ let must_escape str =
     in
     loop (len - 1)
 
-let maybe_esc_str str =
-  if must_escape str then
-    let estr = String.escaped str in
-    let elen = String.length estr in
-    let res = String.create (elen + 2) in
-    String.blit estr 0 res 1 elen;
-    res.[0] <- '"';
-    res.[elen + 1] <- '"';
-    res
-  else str
-
-let pp_maybe_esc_str ppf str = pp_print_string ppf (maybe_esc_str str)
+let esc_str str =
+  let estr = String.escaped str in
+  let elen = String.length estr in
+  let res = String.create (elen + 2) in
+  String.blit estr 0 res 1 elen;
+  res.[0] <- '"';
+  res.[elen + 1] <- '"';
+  res
+
+let index_of_newline str start =
+  try Some (String.index_from str start '\n')
+  with Not_found -> None
+
+let get_substring str index end_pos_opt =
+  let end_pos =
+    match end_pos_opt with
+    | None -> String.length str
+    | Some end_pos -> end_pos
+  in
+  String.sub str index (end_pos - index)
+
+let is_one_line str =
+  match index_of_newline str 0 with
+  | None -> true
+  | Some index -> index + 1 = String.length str
+
+let pp_hum_maybe_esc_str ppf str =
+  if not (must_escape str) then
+    pp_print_string ppf str
+  else if is_one_line str then
+    pp_print_string ppf (esc_str str)
+  else begin
+    let rec loop index =
+      let next_newline = index_of_newline str index in
+      let next_line = get_substring str index next_newline in
+      pp_print_string ppf (String.escaped next_line);
+      match next_newline with
+      | None ->  ()
+      | Some newline_index ->
+        pp_print_string ppf "\\";
+        pp_force_newline ppf ();
+        pp_print_string ppf "\\n";
+        loop (newline_index + 1)
+    in
+    pp_open_box ppf 0;
+    (* the leading space is to line up the lines *)
+    pp_print_string ppf " \"";
+    loop 0;
+    pp_print_string ppf "\"";
+    pp_close_box ppf ();
+  end
 
+let mach_maybe_esc_str str =
+  if must_escape str then esc_str str else str
 
 (* Output of S-expressions to formatters *)
 
 let rec pp_hum_indent indent ppf = function
-  | Atom str -> pp_maybe_esc_str ppf str
+  | Atom str -> pp_hum_maybe_esc_str ppf str
   | List (h :: t) ->
       pp_open_box ppf indent;
       pp_print_string ppf "(";
@@ -65,7 +106,7 @@ and pp_hum_rest indent ppf = function
 
 let rec pp_mach_internal may_need_space ppf = function
   | Atom str ->
-      let str' = maybe_esc_str str in
+      let str' = mach_maybe_esc_str str in
       let new_may_need_space = str' == str in
       if may_need_space && new_may_need_space then pp_print_string ppf " ";
       pp_print_string ppf str';
@@ -106,7 +147,7 @@ let to_buffer_hum ~buf ?(indent = !default_indent) sexp =
 let to_buffer_mach ~buf sexp =
   let rec loop may_need_space = function
     | Atom str ->
-        let str' = maybe_esc_str str in
+        let str' = mach_maybe_esc_str str in
         let new_may_need_space = str' == str in
         if may_need_space && new_may_need_space then Buffer.add_char buf ' ';
         Buffer.add_string buf str';
@@ -129,7 +170,7 @@ let to_buffer = to_buffer_mach
 let to_buffer_gen ~buf ~add_char ~add_string sexp =
   let rec loop may_need_space = function
     | Atom str ->
-        let str' = maybe_esc_str str in
+        let str' = mach_maybe_esc_str str in
         let new_may_need_space = str' == str in
         if may_need_space && new_may_need_space then add_char buf ' ';
         add_string buf str';
@@ -255,14 +296,15 @@ let save_sexps = save_sexps_mach
 (* String conversions *)
 
 let to_string_hum ?indent = function
-  | Atom str -> maybe_esc_str str
+  | Atom str when index_of_newline str 0 = None ->
+    mach_maybe_esc_str str
   | sexp ->
       let buf = buffer () in
       to_buffer_hum ?indent sexp ~buf;
       Buffer.contents buf
 
 let to_string_mach = function
-  | Atom str -> maybe_esc_str str
+  | Atom str -> mach_maybe_esc_str str
   | sexp ->
       let buf = buffer () in
       to_buffer_mach sexp ~buf;

lib/sexp_with_layout.ml

@@ -109,7 +109,7 @@ module Render = struct
     | Atom (delta, text, fmt_text) ->
       let fmt_text =
         match fmt_text with
-        | None | Some "" -> Pre_sexp.maybe_esc_str text
+        | None | Some "" -> Pre_sexp.mach_maybe_esc_str text
         | Some text -> text
       in
       let unescaped = fmt_text.[0] <> '"' in

lib_test/newlines.expected

@@ -0,0 +1,93 @@
+------ simple atom ------
+mach:
+line1
+hum:
+line1
+
+------ one trailing newline ------
+mach:
+"line1\n"
+hum:
+"line1\n"
+
+------ two lines ------
+mach:
+"line1\nline2"
+hum:
+ "line1\
+\nline2"
+
+------ two lines and trailing newline ------
+mach:
+"line1\nline2\n"
+hum:
+ "line1\
+\nline2\
+\n"
+
+------ two lines, windows style ------
+mach:
+"line1\r\nline2"
+hum:
+ "line1\r\
+\nline2"
+
+------ two lines and trailing windows style ------
+mach:
+"line1\r\nline2\r\n"
+hum:
+ "line1\r\
+\nline2\r\
+\n"
+
+------ two lines inside of parens ------
+mach:
+("line1\nline2")
+hum:
+( "line1\
+ \nline2")
+
+------ many lines and indentation in the atom ------
+mach:
+"line1\n line2\n  line3\n   line4\n"
+hum:
+ "line1\
+\n line2\
+\n  line3\
+\n   line4\
+\n"
+
+------ indentation with tabs in the atom ------
+mach:
+"line1\n\tline2\n\t\tline3\n\t\t\tline4\n"
+hum:
+ "line1\
+\n\tline2\
+\n\t\tline3\
+\n\t\t\tline4\
+\n"
+
+------ trailing whitespace ------
+mach:
+(("line1  \n  line3  \n  "))
+hum:
+(( "line1  \
+  \n  line3  \
+  \n  "))
+
+------ catalog snapshot ------
+mach:
+"                cancel-buy\n                |  cancel-sell\n                |  |  local-buy\n                |  |  |    local-cancel-buy\n                |  |  |    |  local-cancel-sell\n                |  |  |    |  |  local-sell\nINDEX      buy  |  |  |    |  |  |  sell\n|          |    |  |  |    |  |  |  |\ntest_sym1  10.        10.           9.\ntest_sym3                             \n"
+hum:
+ "                cancel-buy\
+\n                |  cancel-sell\
+\n                |  |  local-buy\
+\n                |  |  |    local-cancel-buy\
+\n                |  |  |    |  local-cancel-sell\
+\n                |  |  |    |  |  local-sell\
+\nINDEX      buy  |  |  |    |  |  |  sell\
+\n|          |    |  |  |    |  |  |  |\
+\ntest_sym1  10.        10.           9.\
+\ntest_sym3                             \
+\n"
+

lib_test/newlines.ml

@@ -0,0 +1,56 @@
+open StdLabels
+open Sexplib
+
+let windowsify_newlines str =
+  let b = Buffer.create (String.length str * 2) in
+  for i = 0 to String.length str - 1; do
+    match str.[i] with
+    | '\n' -> Buffer.add_string b "\r\n"
+    | c -> Buffer.add_char b c
+  done;
+  Buffer.contents b
+
+let () =
+  List.iter [
+    "simple atom", Sexp.Atom "line1";
+    "one trailing newline", Sexp.Atom "line1\n";
+    "two lines", Sexp.Atom "line1\nline2";
+    "two lines and trailing newline", Sexp.Atom "line1\nline2\n";
+    "two lines, windows style", Sexp.Atom "line1\r\nline2";
+    "two lines and trailing windows style", Sexp.Atom "line1\r\nline2\r\n";
+    "two lines inside of parens", Sexp.of_string "(\"line1\nline2\")";
+    "many lines and indentation in the atom", Sexp.Atom "line1\n line2\n  line3\n   line4\n";
+    "indentation with tabs in the atom", Sexp.Atom "line1\n\tline2\n\t\tline3\n\t\t\tline4\n";
+    "trailing whitespace", Sexp.List [Sexp.List [Sexp.Atom "line1  \n  line3  \n  "]];
+    "catalog snapshot", Sexp.Atom "                cancel-buy\n                |  cancel-sell\n                |  |  local-buy\n                |  |  |    local-cancel-buy\n                |  |  |    |  local-cancel-sell\n                |  |  |    |  |  local-sell\nINDEX      buy  |  |  |    |  |  |  sell\n|          |    |  |  |    |  |  |  |\ntest_sym1  10.        10.           9.\ntest_sym3                             \n";
+  ] ~f:(fun (title, sexp) ->
+    (* My understanding of newlines on windows is that in memory, a newline is a \n, but
+       when writing to a file with a file handler open in text mode, all the \n are
+       replaced with \r\n. Of course the conversion is undone when reading with a file
+       handler open in text mode. If saving \n in text-mode and reading it in binary mode,
+       we would receive \r\n back.
+       I am testing that serializing + writing in text mode + reading in binary mode +
+       deserializing is the identity (because it was before this newline printing stuff),
+       and all the other cases should just work. *)
+    let reparsed = Sexp.of_string (Sexp.to_string_hum sexp) in
+    let reparsed_after_windows_fiddling =
+      Sexp.of_string (windowsify_newlines (Sexp.to_string_hum sexp))
+    in
+    let reparsing_result =
+      if reparsed <> sexp then
+        Printf.sprintf "to_string_hum + of_string + to_mach is NOT the identity:\n%s\n"
+          (Sexp.to_string_mach reparsed)
+      else ""
+    in
+    let reparsing_after_windows_fiddling_result =
+      if reparsed_after_windows_fiddling <> sexp then
+        Printf.sprintf "to_string_hum + windowsify + of_string + to_mach is NOT the identity:\n%s\n"
+          (Sexp.to_string_mach reparsed_after_windows_fiddling)
+      else ""
+    in
+    Printf.printf "------ %s ------\nmach:\n%s\nhum:\n%s\n%s%s\n"
+      title
+      (Sexp.to_string_mach sexp)
+      (Sexp.to_string_hum sexp)
+      reparsing_result reparsing_after_windows_fiddling_result
+  )

lib_test/parser_test.ml

@@ -108,6 +108,12 @@ let list_parsers = [
 let tests = ref 0
 let failures = ref 0
 
+let string_of_loc loc =
+  Printf.sprintf "%s:%d:%d"
+    loc.Lexing.pos_fname
+    loc.Lexing.pos_lnum
+    (loc.Lexing.pos_cnum - loc.Lexing.pos_bol)
+
 let same_parse_tree ?no_following_sibling ?(use_list_parsers=false) loc string1 string2 =
   let context_wrappers = wrap_in_context ?no_following_sibling () in
   List.iter (fun context_wrapper ->
@@ -125,14 +131,14 @@ let same_parse_tree ?no_following_sibling ?(use_list_parsers=false) loc string1
             incr failures;
             Printf.printf
               "test failure at %s (%s, %s)\n  string1: %S tree1: %s\n  string2: %S tree2: %s\n%!"
-              loc parser_name newline_style
+              (string_of_loc loc) parser_name newline_style
               string1 (Sexp.to_string tree1)
               string2 (Sexp.to_string tree2)
           )
         with e ->
           incr failures;
           Printf.printf "test failure at %s (%s, %s, %s) on %S vs %S\n%!"
-            loc (Printexc.to_string e) parser_name newline_style string1 string2
+            (string_of_loc loc) (Printexc.to_string e) parser_name newline_style string1 string2
       ) newline_adapters
     ) (if use_list_parsers then list_parsers else parsers)
   ) context_wrappers
@@ -153,12 +159,12 @@ let parse_fail ?no_following_sibling ?(use_list_parsers=false) loc string f =
           incr failures;
           Printf.printf
             "test failure at %s (%s, %s): should have thrown an exception\nstring: %S tree: %s\n%!"
-            loc parser_name newline_style string (Sexp.to_string tree)
+            (string_of_loc loc) parser_name newline_style string (Sexp.to_string tree)
         with e ->
           if not (f e) then (
             incr failures;
             Printf.printf "test failure at %s (%s, %s, %s)\n%!"
-              loc (Printexc.to_string e) parser_name newline_style
+              (string_of_loc loc) (Printexc.to_string e) parser_name newline_style
           )
       ) newline_adapters
     ) (if use_list_parsers then list_parsers else parsers)
@@ -167,11 +173,6 @@ let parse_fail ?no_following_sibling ?(use_list_parsers=false) loc string f =
 let parse_fail_trees ?no_following_sibling loc string f =
   parse_fail ?no_following_sibling ~use_list_parsers:true loc string f
 
-#define _here_ \
-    (try assert false; exit 45 \
-     with Assert_failure (position, line, col) -> \
-       Printf.sprintf "%s:%d:%d" position line col)
-
 let grep pattern string =
   (* hopefully there is no need for escaping *)
   Sys.command ("echo '" ^ string ^ "' | grep -q '" ^ pattern ^ "'") = 0