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 *)
Block?Block[{kkk}, kkk[] := 1; TestF[]]will use new definition ofkkkonly insideBlock. – jkuczm Apr 25 '17 at 10:24