From 0201c5176c3ad0d197f610aa86b66d5b728c32cc Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 21 Feb 2012 10:44:03 +0000 Subject: [PATCH] pa_when: Allow >> in scripts to be escaped as >\>. --- lib/pa_when.ml | 34 ++++++++++++++++++++++++++++++++-- 1 file changed, 32 insertions(+), 2 deletions(-) diff --git a/lib/pa_when.ml b/lib/pa_when.ml index 3b8f36e..0d16469 100644 --- a/lib/pa_when.ml +++ b/lib/pa_when.ml @@ -33,6 +33,36 @@ let unique = let i = ref 0 in fun () -> incr i; !i let unique_job_name () = sprintf "job$%d" (unique ()) +let rec find s sub = + let len = String.length s in + let sublen = String.length sub in + let rec loop i = + if i <= len-sublen then ( + let rec loop2 j = + if j < sublen then ( + if s.[i+j] = sub.[j] then loop2 (j+1) + else -1 + ) else + i (* found *) + in + let r = loop2 0 in + if r = -1 then loop (i+1) else r + ) else + -1 (* not found *) + in + loop 0 + +let rec replace_str s s1 s2 = + let len = String.length s in + let sublen = String.length s1 in + let i = find s s1 in + if i = -1 then s + else ( + let s' = String.sub s 0 i in + let s'' = String.sub s (i+sublen) (len-i-sublen) in + s' ^ s2 ^ replace_str s'' s1 s2 + ) + (* Convert a _loc to an AST. *) let expr_of_loc _loc loc = let file_name, @@ -87,8 +117,8 @@ let () = let sh_quotation_expander _loc _ sh = let loc = expr_of_loc _loc _loc in - (* XXX Expand %- or $- expressions in code. *) - (* XXX Escape >> in code. *) + (* Convert ">\>" to ">>" in code. *) + let sh = replace_str sh ">\\>" ">>" in <:expr< { Whenutils.sh_loc = $loc$; sh_script = $str:sh$ } >> -- 1.8.3.1