Permalink
Browse files

Fixed some serious problems with generated clauses order

  • Loading branch information...
1 parent d08f588 commit 5c565f8c5d4e4b37715f9ba3ec5c9e422348bdc8 @yrashk committed Sep 29, 2009
Showing with 39 additions and 10 deletions.
  1. +12 −8 src/recmod.erl
  2. +7 −1 t/baserecmod.erl
  3. +5 −1 t/extrecmod.erl
  4. +15 −0 t/tests.erl
View
@@ -196,17 +196,17 @@ field({record_field,_L,{atom, _L1, Field}, _InitExpr}) ->
%%
function(Name, Arity, Clauses0, St) ->
- Clauses1 = clauses(Name,Clauses0,St),
+ Clauses1 = clauses(original, Name,Clauses0,St) ++ clauses(function_clause, Name,Clauses0,St) ++ clauses(coercion, Name,Clauses0,St),
{Name,Arity,Clauses1}.
-clauses(Name,[C|Cs],St) ->
+clauses(Tag, Name,[C|Cs],St) ->
{clause,L,H,G,B} = clause(C,St),
T = {tuple,L,[{atom, L, St#recmod.name}|
[{var,L, V} || {_,V} <- St#recmod.parameters ]
]},
- emit_clause(original, Name,L,H,T,G,B,St) ++ emit_clause(function_clause, Name,L,H,T,G,B,St) ++ emit_clause(coercion, Name,L,H,T,G,B,St) ++ clauses(Name,Cs,St);
+ emit_clause(Tag, Name,L,H,T,G,B,St) ++ clauses(Tag, Name,Cs,St);
-clauses(_,[],_St) -> [].
+clauses(_,_,[],_St) -> [].
clause({clause,L,H0,G0,B0},St) ->
H1 = head(H0,St),
@@ -239,15 +239,19 @@ emit_clause(function_clause, Name, L,H,T,_G,_B,#recmod{extends=Extends}=St) when
];
emit_clause(function_clause, _Name, _L,_H,_T,_G,_B,_St) ->
[];
-emit_clause(coercion, Name, L,H,_T,_G,_B,_St) ->
+emit_clause(coercion, Name, L,H,_T,_G,_B,St) ->
{H1,_} = lists:foldl(fun (H0,{Hs,Ctr}) -> {[{match, L, dereference(H0), {var, L, list_to_atom("_Arg" ++ erlang:integer_to_list(Ctr))}}|Hs],Ctr+1} end, {[],1}, H),
H1Args = lists:map(fun (Ctr) -> {var, L, list_to_atom("_Arg" ++ erlang:integer_to_list(Ctr))} end, lists:seq(1,length(H1))),
- [{clause,L,H1++[{match,L,{var,L,'_'},{var,L,'THIS'}}],[], % THIS does not match, lets try to corce it
- [
+ [{clause,L,H1++[{match,L,{var,L,'_'},{var,L,'THIS'}}],[
+ [{op, L, '/=',
+ {call,L,{remote,L,{atom, L, erlang},{atom, L, element}},[{integer, L, 1}, {var, L, 'THIS'}]},
+ {atom, L, St#recmod.name}
+ }]
+ ],
+ [ % THIS does not match, lets try to corce it
{call, L, {atom, L, Name}, H1Args++[{tuple, L, [{var, L, 'THIS'},{call,L,{remote,L,{var,L,'THIS'},{atom, L, to_base}}, []}]}]}
]}].
-
dereference({var, L, _Name}) ->
{var, L, '_'};
dereference(H) ->
View
@@ -1,7 +1,7 @@
-module(baserecmod).
-compile({parse_transform, recmod}).
-include("records.hrl").
--export([st/0,argless/0,somefun/1,someotherfun/0, defaultimports/0,localcall/0,localcall/1]).
+-export([st/0,argless/0,somefun/1,someotherfun/0, defaultimports/0,localcall/0,localcall/1, recguarded/0]).
-static([st/0]).
st() ->
@@ -34,3 +34,9 @@ this() ->
this(A) ->
{THIS,A}.
+
+recguarded() when Field1 > 1 ->
+ more;
+recguarded() when Field1 =< 1 ->
+ less.
+
View
@@ -2,8 +2,12 @@
-compile({parse_transform, recmod}).
-extends(baserecmod).
-include("records.hrl").
--export([somefun/1]).
+-export([somefun/1, recguarded/0]).
somefun(Arg) when Otherfield == "password" ->
Arg.
+recguarded() when Field1 > 1 ->
+ emore;
+recguarded() when Field1 =< 1 ->
+ eless.
View
@@ -202,4 +202,19 @@ test("Should export static functions properly") ->
fun () ->
static = baserecmod:st()
end}];
+
+test("Should respect field guards") ->
+ [{f,
+ fun () ->
+ more = (#baserecmod{field1=2}):recguarded(),
+ less = (#baserecmod{field1=0}):recguarded()
+ end}];
+
+test("Should respect field guards in the extension module") ->
+ [{f,
+ fun () ->
+ emore = (#extrecmod{field1=2}):recguarded(),
+ eless = (#extrecmod{field1=0}):recguarded()
+ end}];
+
?EOT.

0 comments on commit 5c565f8

Please sign in to comment.