From e1e736840ed8c925e2ff442861963250a72d4385 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Tue, 24 Oct 2017 13:08:15 +0200 Subject: Update sheet traversal --- Makefile | 7 +++++-- errors.ml | 2 ++ sheet.ml | 34 +++++++++++++++++++--------------- sheet.mli | 2 -- tests/sheet_test.ml | 13 +++++++------ 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; -- cgit v1.2.3