Fixed an out of bounds error in rope. Turned on exception backtraces and added a...

diff --git a/Makefile b/Makefile
index 694943457d5f515c89556af0afe86009defe07e3..da529fd4fb8926d200a27ddff718bb22921cfda7 100644 (file)
--- 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 e45eb6940a9ca36ac58cee6ed66f88b04ee92e23..0cdbbe11ad9dc673500f22f8eef4a3d72cb85de0 100644 (file)
--- 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 16e699a931792fffaa91367a0668b15605b198a3..f3c16fb13487d762865017fdff0820ff6a9291ab 100644 (file)
--- 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 156b8d5656b6e240a746f995cb5ea1e7e08562f6..b98eefbb4c73cfc1585ecc4cb8d23d98521c969c 100644 (file)
--- 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 () ->