6

I am trying to set up the unit testing environment for mathematica code.

The problem I am getting is that I can't find a way to mock the methods that my functions use inside Module - they are always taken from the initial context that they were defined in. The only way seems to be re-defining them directly in the context they are defined in - e.g. `Global``.

I want to find a better way to provide alternative mocks of methods for each of my test:

TestF[] := Module[{}, Print[Context[kkk]]; kkk[]];
kkk[] := 0;

Begin["TestContext`"];
kkk[] := 1;

TestF[]
(* => 
Global`
1
*)
End[]

TestF[]
(* => still...
Global`
1
*)

I want to be able to use the mock kkk[] so that it is only changed inside the test session and does not affect other tests that may use original implementation of kkk[]

grandrew
  • 550
  • 2
  • 10

1 Answers1

5

If you want to locally override behavior of some symbols you can use Block which will completely remove original behavior, or Internal`InheritedBlock which will keep original behavior that was not explicitly overridden.

ClearAll[testF, kkk]
testF[] := kkk[]
kkk[] = 0;

testF[]
(* 0 *)

Block[{kkk},
  kkk[] = 1;
  testF[]
]
(* 1 *)

testF[]
(* 0 *)

We can automate extraction of overridden symbols from assignment expressions, so we won't have to repeat them in Blocks variable list. To do it we create a parser that can extract assignment tag from arbitrary pattern.

$panic = Function[, Throw[HoldComplete@#1, #2], HoldAllComplete];

symPatt = Except[HoldPattern@Symbol@___, _Symbol];
oneArgPatt = Blank | BlankNullSequence | BlankSequence | HoldPattern | IgnoringInactive | Literal | Longest | Repeated | RepeatedNull | Shortest;
twoArgFirstPatt = Condition | Longest | PatternTest | Repeated | RepeatedNull | Shortest;
twoArgSecondPatt = Except | Pattern;
pattPatt = Blank /@ Join[oneArgPatt, twoArgFirstPatt, twoArgSecondPatt, Alternatives@Verbatim];
valuesHeadPatt = Attributes | DefaultValues | DownValues | FormatValues | Messages | NValues | Options | OwnValues | SubValues | UpValues;

patternTags // ClearAll
patternTags[oneArgPatt@patt_ | twoArgFirstPatt[patt_, _] | twoArgSecondPatt[_, patt_], head_, False] := patternTags[patt, head, False]
patternTags[Verbatim[Verbatim]@patt_, head_, False] := patternTags[patt, head, True]
patternTags[patt : pattPatt, _, False] := $panic[patt, "noPatternTag"]
patternTags[patt_@___, True, verbatim_] := patternTags[patt, True, verbatim]
patternTags[sym : symPatt, True, _] := HoldComplete@sym
patternTags[_@args___, False, verbatim_] := Union @@ Replace[Unevaluated@{args}, x_ :> patternTags[x, True, verbatim], {1}]
patternTags[patt_, _, _] := $panic[patt, "noPatternTag"]
patternTags // Attributes = HoldAllComplete;

setTags // ClearAll
setTags@(Set | SetDelayed)[valuesHeadPatt[sym : symPatt], _] := HoldComplete@sym
setTags@(Set | SetDelayed)[lhs_, _] := patternTags[lhs, True, False]
setTags@(TagSet | TagSetDelayed)[sym : symPatt, _, _] := HoldComplete@sym
setTags@(UpSet | UpSetDelayed)[lhs_, _] := patternTags[lhs, False, False]
setTags@expr_ := $panic[expr, "nonAssignment"];
setTags // Attributes = HoldAllComplete;

Now final withStub function accepting assignments as argument and returning environment in which those assignments are locally used.

addDefaultDefinition // ClearAll
addDefaultDefinition@default_ := Function[,
  AppendTo[DownValues@#, HoldPattern@call : Blank@# :> default@HoldComplete@call],
  HoldAllComplete
]

withStubInternal // ClearAll
withStubInternal[block_, HoldComplete@symSeq___, HoldComplete@assign___] := Function[,
  block[{symSeq}, Module[{protected = Unprotect@symSeq},
    assign;
    Protect@protected;
    #
  ]],
  HoldFirst
]

withStub // ClearAll
withStub // Attributes = HoldFirst;
withStub // Options = {"DefaultStub" -> Inherited};
withStub[(List | CompoundExpression)[assignSeq__] | assign_, OptionsPattern[]] := With[
  {
    default = OptionValue@"DefaultStub",
    heldSyms = Union @@ Replace[
      Unevaluated@{assignSeq, assign},
      {s : symPatt :> HoldComplete@s, x_ :> setTags@x},
      {1}
    ]
  },
  withStubInternal[
    If[default === Inherited, Internal`InheritedBlock, Block],
    heldSyms,
    Join[HoldComplete[assignSeq, assign],
      If[MatchQ[default, None | Inherited],
        HoldComplete[],
        HoldComplete@Scan[addDefaultDefinition@default, heldSyms]
      ]
    ]
  ]
]
call_withStub := $panic[call, "wrongArgs"]

Example test function that calls other functions:

ClearAll[kkk, jjj, a, x, testF]
kkk@x_ := 2 x
testF@x_ := {kkk@x, kkk@a, kkk[x, a], jjj@x}

Ordinary call to testF gives:

testF@x
(* {2 x, 2 a, kkk[x, a], jjj[x]} *)

Calls with example of overridden functions give:

env = withStub[kkk@x = 1; jjj@x_ := 5 x]
env@testF@x
env@testF@y
(* Function[Null, Internal`InheritedBlock[{jjj, kkk}, Module[{protected$ = Unprotect[jjj, kkk]}, kkk[x] = 1; jjj[x_] := 5 x; Protect[protected$]; #1]], HoldFirst] *)
(* {1, 2 a, kkk[x, a], 5 x} *)
(* {2 y, 2 a, kkk[y, a], 5 y} *)

Behavior of calls, to symbols with overridden definitions, that don't match any of overridden patterns depends on "DefaultStub" option. With "DefaultStub" -> Inherited (default value) function patterns, that are not overridden, inherit their old behavior. With "DefaultStub" -> None they remain unevaluated. Any other value of "DefaultStub" is treated as function evaluated on every call to overridden symbol that doesn't match overridden pattern.

withStub[kkk@x = 1, "DefaultStub" -> Inherited][
  Hold @@ testF@x
]
withStub[kkk@x = 1, "DefaultStub" -> None][
  Hold @@ testF@x
]
withStub[kkk@x = 1, "DefaultStub" -> Throw][
  Hold @@ testF@x
]
(* Hold[1, 2 a, kkk[x, a], jjj[x]] *)
(* Hold[1, kkk[a], kkk[x, a], jjj[x]] *)
(* Throw::nocatch: Uncaught Throw[HoldComplete[kkk[a]]] returned to top level.
   Hold[Throw[HoldComplete[kkk[a]]]] *)

Outside of "stub environment" functions are unchanged:

?? kkk
(* Global`kkk
   kkk[x_]:=2 x *)
jkuczm
  • 15,078
  • 2
  • 53
  • 84