From 0201c5176c3ad0d197f610aa86b66d5b728c32cc Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
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