Update sheet traversal

5 files changed, 33 insertions, 25 deletions

diff --git a/Makefile b/Makefile
index bf896ac..ec420a0 100755
--- a/Makefile
+++ b/Makefile
@@ -30,8 +30,11 @@ native: stub
 doc:

 	$(OCAMLBUILD) -pkgs $(PACKAGES) -menhir -Is $(PATHS) licht.docdir/index.html

 

-test: stub

-	$(OCAMLBUILD) -pkgs $(PACKAGES),oUnit -cflag -g -lflag -g $(STUB_OPTIONS) $(MENHIR) -Is $(PATHS),tests,tests/odf test.byte --

+test.byte: stub

+	$(OCAMLBUILD) -pkgs $(PACKAGES),oUnit -cflag -g -lflag -g $(STUB_OPTIONS) $(MENHIR) -Is $(PATHS),tests,tests/odf $@

+

+test: test.byte

+	./test.byte

 

 relink: stub

 	rm -f _build/main.native

diff --git a/errors.ml b/errors.ml
index 8f389ce..3751a60 100755
--- a/errors.ml
+++ b/errors.ml
@@ -4,6 +4,8 @@ exception Undefined of UTF8.t * string list
 

 exception TypeError

 

+exception Cycle

+

 let printf formatter = function

   | Undefined (name, args) -> Format.fprintf formatter

       "There is no function '%s' with signature %a"

diff --git a/sheet.ml b/sheet.ml
index 256a5a1..a31c9ef 100755
--- a/sheet.ml
+++ b/sheet.ml
@@ -10,8 +10,6 @@ type search = [
 

 module Raw = struct

 

-  exception Cycle

-

   module Map = Map.Make(struct

     type t = cell

     let compare (x1, y1) (x2, y2) = Pervasives.compare (y1, x1) (y2, x2)

@@ -30,7 +28,7 @@ module Raw = struct
 

   (** An empty cell which does contains nothing *)

   let empty_cell = {

-    expr = Expression.load @@ UTF8.empty;

+    expr = Expression.Undefined;

     value = None;

     sink = Cell.Set.empty;

   }

@@ -73,7 +71,7 @@ module Raw = struct
       (* If the previous value wasn't defined, update the map *)

       Some (Map.add cell { content with value = Some new_val } t)

     | Some old_value ->

-      (* If the previous value was defined, update only if both differs *)

+      (* If the previous value was defined, update only if result differs *)

       if not (ScTypes.Result.(=) new_val old_value) then

         Some (Map.add cell { content with value = Some new_val } t)

       else

@@ -89,19 +87,25 @@ module Raw = struct
     let rec successors element (parents, succ, t) = begin

 

       let content = Map.find element t in

+

       if Cell.Set.mem element parents then (

         (* if the cell has already been visited, mark it in error, and all the

            descendant *)

-        let cycle_error = Some (ScTypes.Error Cycle) in

-        let t = Map.add element { content with value = cycle_error} t

-        and set_error cell content t =

-          if content.value = cycle_error then

-            None

-          else

-            Some (Map.add cell { content with value = cycle_error} t) in

-        let succ = Cell.Set.add element succ in

-        let succ, t = traverse set_error content (succ, t) in

-        (Cell.Set.empty, succ, t)

+        let cycle_error = Some (ScTypes.Error Errors.Cycle) in

+

+        if content.value = cycle_error then

+          (* The content has already been update, do not process it again *)

+          (Cell.Set.empty, succ, t)

+        else

+          let t = Map.add element { content with value = cycle_error} t

+          and set_error cell content t =

+            if content.value = cycle_error then

+              None

+            else

+              Some (Map.add cell { content with value = cycle_error} t)

+          and succ = Cell.Set.add element succ in

+          let succ, t = traverse set_error content (succ, t) in

+          (Cell.Set.empty, succ, t)

       ) else (

         begin match f element content t with

         | None ->

@@ -117,7 +121,7 @@ module Raw = struct
         end

       )

     end in

-    let _, succ, t = Cell.Set.fold successors source.sink (Cell.Set.empty, init, t) in

+    let _, succ, t = Cell.Set.fold successors source.sink (init, init, t) in

     succ, t

   end

 

diff --git a/sheet.mli b/sheet.mli
index d3c8151..0762419 100755
--- a/sheet.mli
+++ b/sheet.mli
@@ -4,8 +4,6 @@ type cell = int * int
   
 module Raw: sig
 
-  exception Cycle
-  
   type t
   
   (** Create a new sheet *)
diff --git a/tests/sheet_test.ml b/tests/sheet_test.ml
index b289b14..c1af5d5 100755
--- a/tests/sheet_test.ml
+++ b/tests/sheet_test.ml
@@ -53,7 +53,7 @@ end
 let test_create_direct_cycle ctx = begin
 
   let s = Sheet.Raw.create
-       |> Sheet.Raw.add (2,2) @@ Expression.load @@ u"=B2"
+       |> Sheet.Raw.add (2,2) @@ Expression.load @@ u"=B2 + 1"
        |> snd in
   let result = (Sheet.Raw.get_value (2, 2) s) in
   let expected = Some (ScTypes.Error Errors.TypeError) in
@@ -68,11 +68,12 @@ let test_create_indirect_cycle ctx = begin
 
   let s = Sheet.Raw.create
        |> Sheet.Raw.add (2,2) @@ Expression.load @@ u"=A1"
-       |> snd |> Sheet.Raw.add (1,1) @@ Expression.load @@ u"=B2"
+       |> snd |> Sheet.Raw.add (1,1) @@ Expression.load @@ u"=2"
+       |> snd |> Sheet.Raw.add (1,1) @@ Expression.load @@ u"=B2+1"
        |> snd |> Sheet.Raw.add (0,0) @@ Expression.load @@ u"=A1"
        |> snd in
   let result = (Sheet.Raw.get_value (0, 0) s) in
-  let expected = Some (ScTypes.Error Errors.TypeError) in
+  let expected = Some (ScTypes.Error Errors.Cycle) in
 
   assert_equal
     ~msg:(_msg ~expected ~result)
@@ -80,7 +81,7 @@ let test_create_indirect_cycle ctx = begin
     result
 end
 
-let test_check_BFS ctx = begin
+let test_check_cycle3 ctx = begin
 
   let s = Sheet.Raw.create
       (* First set A1 to 3 *)
@@ -158,11 +159,11 @@ let test_update_succs2 ctx = begin
 end
 
 let tests = "sheet_test">::: [
-    "test_ref2"     >:: test_create_ref_2;
     "test_ref1"     >:: test_create_ref_1;
+    "test_ref2"     >:: test_create_ref_2;
     "test_cycle1"   >:: test_create_direct_cycle;
     "test_cycle2"   >:: test_create_indirect_cycle;
-    "test_BFS"      >:: test_check_BFS;
+    "test_cycle3"   >:: test_check_cycle3;
     "test_delete"   >:: test_delete;
     "test_update_succs1"   >:: test_update_succs1;
     "test_update_succs2"   >:: test_update_succs2;