From fd7f09064189d979a40b91c8ebdacdf0a81764ea Mon Sep 17 00:00:00 2001
From: "Michael D. Lowis" <mike.lowis@gentex.com>
Date: Mon, 13 Nov 2017 09:32:23 -0500
Subject: [PATCH] Fixed an out of bounds error in rope. Turned on exception
 backtraces and added a try-with block to the event handler. Exceptions will
 not cause the editor to exit.

---
 Makefile            |  4 ++--
 edit.ml             |  8 +++++++-
 lib/rope.ml         | 20 ++++++--------------
 tests/rope_tests.ml |  8 --------
 4 files changed, 15 insertions(+), 25 deletions(-)

diff --git a/Makefile b/Makefile
index 6949434..da529fd 100644
--- a/Makefile
+++ b/Makefile
@@ -13,12 +13,12 @@ ifeq ($(NATIVE), 1)
     OLDFLAGS   = -compact -ccopt -dead_strip
 else
     OC         = ocamlc
-    OCFLAGS    =
+    OCFLAGS    = -g
     MKLIB      = ocamlmklib
     MKLIBFLAGS =
     OBJEXT     = cmo
     LIBEXT     = cma
-    OLDFLAGS   = -dllpath .
+    OLDFLAGS   = -g -dllpath .
 endif
 
 # Target Definitions
diff --git a/edit.ml b/edit.ml
index e45eb69..0cdbbe1 100644
--- a/edit.ml
+++ b/edit.ml
@@ -32,7 +32,8 @@ let onupdate width height =
 
 let onshutdown () = ()
 
-let onevent = function
+let onevent evnt =
+  try match evnt with
   | Focus state      -> onfocus state
   | KeyPress e       -> onkeypress e.mods e.rune
   | MouseClick e     -> onmousebtn e.mods e.btn e.x e.y true
@@ -45,10 +46,15 @@ let onevent = function
   | PipeReadReady e  -> () (*print_endline "pipereadready"*)
   | Update e         -> onupdate e.width e.height
   | Shutdown         -> onshutdown ()
+  with e -> begin
+    print_endline (Printexc.to_string e);
+    Printexc.print_backtrace stdout
+  end
 
 (* Main Routine
  ******************************************************************************)
 let () =
+  Printexc.record_backtrace true;
   if Array.length Sys.argv > 1 then
     edit_view := View.make 640 480 Sys.argv.(1);
   let win = make_window 640 480 in
diff --git a/lib/rope.ml b/lib/rope.ml
index 16e699a..f3c16fb 100644
--- a/lib/rope.ml
+++ b/lib/rope.ml
@@ -34,8 +34,9 @@ let last rope =
   limit_index rope ((length rope) - 1)
 
 let check_index rope i =
-  if i < 0 || i >= (length rope) then
+  if i < 0 || i >= (length rope) then begin
     raise (Out_of_bounds "Rope.check_index")
+  end
 
 let rec getb rope i =
   check_index rope i;
@@ -101,7 +102,7 @@ let gets rope i j =
     rope i;
   Bytes.unsafe_to_string buf
 
-(* Rebalancing:
+(* Rebalancing Algorithm from the original paper on ropes:
 
 * Height of leaf is 0
 * Height of a node is (1 + max(left,right))
@@ -201,19 +202,10 @@ let putc rope i c =
   puts rope (String.make 1 (Char.chr c)) i
 
 let nextc rope pos =
-  let next = limit_index rope (pos + 1) in
-  if (getb rope pos) == '\r' && (getb rope next) == '\n' then
-    limit_index rope (pos + 2)
-  else
-    next
+  limit_index rope (pos + 1)
 
 let prevc rope pos =
-  let prev1 = limit_index rope (pos - 1) in
-  let prev2 = limit_index rope (pos - 2) in
-  if (getb rope prev2) == '\r' && (getb rope prev1) == '\n' then
-    prev2
-  else
-    prev1
+  limit_index rope (pos - 1)
 
 let is_bol rope pos =
   if pos == 0 then true
@@ -226,7 +218,7 @@ let is_eol rope pos =
 
 let rec move_till step testfn rope pos =
   let adjust_pos = if step < 0 then prevc else nextc in
-  if (testfn rope pos) then pos
+  if (testfn rope pos) || pos == 0 || pos == (last rope) then pos
   else (move_till step testfn rope (adjust_pos rope pos))
 
 let to_bol rope pos =
diff --git a/tests/rope_tests.ml b/tests/rope_tests.ml
index 156b8d5..b98eefb 100644
--- a/tests/rope_tests.ml
+++ b/tests/rope_tests.ml
@@ -133,10 +133,6 @@ let  () =
     let rope = Leaf("a\na", 0, 3) in
     assert( 2 == (nextc rope 1) );
   );
-  test "nextc : should return pos of next char" (fun () ->
-    let rope = Leaf("a\r\na", 0, 4) in
-    assert( 3 == (nextc rope 1) );
-  );
 
   (* prevc() tests *)
   test "prevc : should return pos if at start of buffer" (fun () ->
@@ -147,10 +143,6 @@ let  () =
     let rope = Leaf("a\na", 0, 3) in
     assert( 1 == (prevc rope 2) );
   );
-  test "prevc : should return pos of prev char" (fun () ->
-    let rope = Leaf("a\r\na", 0, 4) in
-    assert( 1 == (prevc rope 3) );
-  );
 
   (* is_bol() tests *)
   test "is_bol : should return true if pos is 0" (fun () ->
-- 
2.52.0