From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/compiler/test/record_SUITE.erl | 525 +++++++++++++++++++++++++++++++++++++ 1 file changed, 525 insertions(+) create mode 100644 lib/compiler/test/record_SUITE.erl (limited to 'lib/compiler/test/record_SUITE.erl') diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl new file mode 100644 index 0000000000..bd2ffd7f65 --- /dev/null +++ b/lib/compiler/test/record_SUITE.erl @@ -0,0 +1,525 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%%% Purpose : Test records. + +-module(record_SUITE). + +-include("test_server.hrl"). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + errors/1,record_test_2/1,record_test_3/1,record_access_in_guards/1, + guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1]). + +init_per_testcase(_Case, Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(2)), + [{watchdog,Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +all(suite) -> + test_lib:recompile(?MODULE), + [errors,record_test_2,record_test_3,record_access_in_guards, + guard_opt,eval_once,foobar,missing_test_heap]. + +-record(foo, {a,b,c,d}). +-record(bar, {a,b,c,d}). +-record(barf, {a,b,c,d,e}). + +errors(Config) when is_list(Config) -> + Foo = #foo{a=1,b=2,c=3,d=4}, + ?line #foo{a=19,b=42,c=3,d=4} = update_foo(Foo, 19, 42), + + ?line {'EXIT',{{badrecord,bar},_}} = (catch update_foo_bar(Foo, 19)), + ?line {'EXIT',{{badrecord,bar},_}} = (catch update_foo_bar(Foo, 19, 35)), + ?line {'EXIT',{{badrecord,bar},_}} = (catch update_foo_bar(Foo, 19, 35, 17)), + ?line {'EXIT',{{badrecord,bar},_}} = (catch update_foo_bar(Foo, 19, 35, 17, 42)), + + ?line {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19)), + ?line {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19, 35)), + ?line {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19, 35, 17)), + ?line {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19, 35, 17, 42)), + ?line {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19, + 35, 17, 42, -2)), + + ok. + +update_foo(#foo{}=R, A, B) -> + R#foo{a=A,b=B}. + +update_foo_bar(#foo{}=R, A) -> + R#bar{a=A}. + +update_foo_bar(#foo{}=R, A, _B) -> + R#bar{a=A,b=A}. + +update_foo_bar(#foo{}=R, A, _B, C) -> + R#bar{a=A,b=A,c=C}. + +update_foo_bar(#foo{}=R, A, _B, C, D) -> + R#bar{a=A,b=A,c=C,d=D}. + +update_foo_barf(#foo{}=R, A) -> + R#barf{a=A}. + +update_foo_barf(#foo{}=R, A, _B) -> + R#barf{a=A,b=A}. + +update_foo_barf(#foo{}=R, A, _B, C) -> + R#barf{a=A,b=A,c=C}. + +update_foo_barf(#foo{}=R, A, _B, C, D) -> + R#barf{a=A,b=A,c=C,d=D}. + +update_foo_barf(#foo{}=R, A, _B, C, D, E) -> + R#barf{a=A,b=A,c=C,d=D,e=E}. + + +-define(TrueGuard(Expr), if Expr -> ok; true -> ?t:fail() end). +-define(FalseGuard(Expr), if Expr -> ?t:fail(); true -> ok end). + +record_test_2(Config) when is_list(Config) -> + ?line true = is_record(#foo{}, foo), + ?line false = is_record(#foo{}, barf), + ?line false = is_record({foo}, foo), + + ?line true = erlang:is_record(#foo{}, foo), + ?line false = erlang:is_record(#foo{}, barf), + ?line false = erlang:is_record({foo}, foo), + + ?line false = is_record([], foo), + ?line false = is_record(Config, foo), + + ?line ?TrueGuard(is_record(#foo{}, foo)), + ?line ?FalseGuard(is_record(#foo{}, barf)), + ?line ?FalseGuard(is_record({foo}, foo)), + + ?line ?TrueGuard(erlang:is_record(#foo{}, foo)), + ?line ?FalseGuard(erlang:is_record(#foo{}, barf)), + ?line ?FalseGuard(erlang:is_record({foo}, foo)), + + ?line ?FalseGuard(is_record([], foo)), + ?line ?FalseGuard(is_record(Config, foo)), + + %% 'not is_record/2' to test guard optimization. + + ?line ?FalseGuard(not is_record(#foo{}, foo)), + ?line ?TrueGuard(not is_record(#foo{}, barf)), + ?line ?TrueGuard(not is_record({foo}, foo)), + + ?line ?FalseGuard(not erlang:is_record(#foo{}, foo)), + ?line ?TrueGuard(not erlang:is_record(#foo{}, barf)), + ?line ?TrueGuard(not erlang:is_record({foo}, foo)), + + Foo = id(#foo{}), + ?line ?FalseGuard(not erlang:is_record(Foo, foo)), + ?line ?TrueGuard(not erlang:is_record(Foo, barf)), + + ?line ?TrueGuard(not is_record(Config, foo)), + + ?line ?TrueGuard(not is_record(a, foo)), + ?line ?TrueGuard(not is_record([], foo)), + + %% Pass non-literal first argument. + + ?line true = is_record(id(#foo{}), foo), + ?line false = is_record(id(#foo{}), barf), + ?line false = is_record(id({foo}), foo), + + ?line true = erlang:is_record(id(#foo{}), foo), + ?line false = erlang:is_record(id(#foo{}), barf), + ?line false = erlang:is_record(id({foo}), foo), + + NoRec1 = id(blurf), + NoRec2 = id([]), + + ?line ?TrueGuard(not is_record(NoRec1, foo)), + ?line ?TrueGuard(not is_record(NoRec2, foo)), + + %% The optimizer attempts to move expressions to guards, + %% but it must not move an is_record/2 call that is not + %% allowed in a guard in the first place. + + ?line ok = case is_record(id({a}), id(a)) of + true -> ok; + false -> error + end, + + %% Force the use of guard bifs by using the 'xor' operation. + + False = id(false), + ?line ?TrueGuard(is_record(#foo{}, foo) xor False), + ?line ?FalseGuard(is_record(#foo{}, barf) xor False), + ?line ?FalseGuard(is_record({foo}, foo) xor False ), + + ?line ?TrueGuard(is_record(Foo, foo) xor False), + ?line ?FalseGuard(is_record(Foo, barf) xor False), + + + %% Implicit guards by using a list comprehension. + + List = id([1,#foo{a=2},3,#bar{d=4},5,#foo{a=6},7]), + + ?line [#foo{a=2},#foo{a=6}] = [X || X <- List, is_record(X, foo)], + ?line [#bar{d=4}] = [X || X <- List, is_record(X, bar)], + ?line [1,#foo{a=2},3,5,#foo{a=6},7] = + [X || X <- List, not is_record(X, bar)], + ?line [1,3,5,7] = + [X || X <- List, ((not is_record(X, bar)) and (not is_record(X, foo)))], + ?line [#foo{a=2},#bar{d=4},#foo{a=6}] = + [X || X <- List, ((is_record(X, bar)) or (is_record(X, foo)))], + ?line [1,3,#bar{d=4}] = + [X || X <- List, ((is_record(X, bar)) or (X < 5))], + + ?line MyList = [#foo{a=3},x,[],{a,b}], + ?line [#foo{a=3}] = [X || X <- MyList, is_record(X, foo)], + ?line [x,[],{a,b}] = [X || X <- MyList, not is_record(X, foo)], + ?line [#foo{a=3}] = [X || X <- MyList, begin is_record(X, foo) end], + ?line [x,[],{a,b}] = [X || X <- MyList, begin not is_record(X, foo) end], + ?line [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, is_record(X, foo) or + not is_binary(X)], + ?line [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, not is_record(X, foo) or + not is_binary(X)], + ?line [#foo{a=3}] = [X || X <- MyList, is_record(X, foo) or is_reference(X)], + ?line [x,[],{a,b}] = [X || X <- MyList, not is_record(X, foo) or + is_reference(X)], + ?line [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, + begin is_record(X, foo) or + not is_binary(X) end], + ?line [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, + begin not is_record(X, foo) or + not is_binary(X) end], + ?line [#foo{a=3}] = [X || X <- MyList, + begin is_record(X, foo) or is_reference(X) end], + ?line [x,[],{a,b}] = [X || X <- MyList, + begin not is_record(X, foo) or + is_reference(X) end], + + %% Call is_record/2 with illegal arguments. + ?line [] = [X || X <- [], is_record(t, id(X))], + ?line {'EXIT',{badarg,_}} = (catch [X || X <- [1], is_record(t, id(X))]), + + %% Update several fields with a string literal. + ?line #barf{} = Barf0 = id(#barf{}), + ?line Barf = update_barf(Barf0), + ?line #barf{a="abc",b=1} = id(Barf), + + ok. + +record_test_3(Config) when is_list(Config) -> + ?line true = is_record(#foo{}, foo, 5), + ?line false = is_record(#foo{}, barf, 5), + ?line false = is_record(#foo{}, barf, 6), + ?line false = is_record({foo}, foo, 5), + + ?line true = erlang:is_record(#foo{}, foo, 5), + ?line false = erlang:is_record(#foo{}, barf, 5), + ?line false = erlang:is_record({foo}, foo, 5), + + ?line false = is_record([], foo), + ?line false = is_record(Config, foo), + + ?line ?TrueGuard(is_record(#foo{}, foo, 5)), + ?line ?FalseGuard(is_record(#foo{}, barf, 5)), + ?line ?FalseGuard(is_record(#foo{}, barf, 6)), + ?line ?FalseGuard(is_record({foo}, foo, 5)), + + ?line ?TrueGuard(erlang:is_record(#foo{}, foo, 5)), + ?line ?FalseGuard(erlang:is_record(#foo{}, barf, 5)), + ?line ?FalseGuard(erlang:is_record(#foo{}, barf, 6)), + ?line ?FalseGuard(erlang:is_record({foo}, foo, 5)), + + ?line ?FalseGuard(is_record([], foo, 5)), + ?line ?FalseGuard(is_record(Config, foo, 5)), + + %% 'not is_record/2' to test guard optimization. + + ?line ?FalseGuard(not is_record(#foo{}, foo, 5)), + ?line ?TrueGuard(not is_record(#foo{}, barf, 6)), + ?line ?TrueGuard(not is_record({foo}, foo, 5)), + + ?line ?FalseGuard(not erlang:is_record(#foo{}, foo, 5)), + ?line ?TrueGuard(not erlang:is_record(#foo{}, barf, 5)), + ?line ?TrueGuard(not erlang:is_record({foo}, foo, 5)), + + Foo = id(#foo{}), + ?line ?FalseGuard(not erlang:is_record(Foo, foo, 5)), + ?line ?TrueGuard(not erlang:is_record(Foo, barf, 6)), + + ?line ?TrueGuard(not is_record(Config, foo, 5)), + + ?line ?TrueGuard(not is_record(a, foo, 5)), + ?line ?TrueGuard(not is_record([], foo, 5)), + + %% Pass non-literal first argument. + + ?line true = is_record(id(#foo{}), foo, 5), + ?line false = is_record(id(#foo{}), barf, 6), + ?line false = is_record(id({foo}), foo, 5), + + ?line true = erlang:is_record(id(#foo{}), foo, 5), + ?line false = erlang:is_record(id(#foo{}), barf, 6), + ?line false = erlang:is_record(id({foo}), foo, 5), + + NoRec1 = id(blurf), + NoRec2 = id([]), + + ?line ?TrueGuard(not is_record(NoRec1, foo, 5)), + ?line ?TrueGuard(not is_record(NoRec2, foo, 5)), + + %% Force the use of guard bifs by using the 'xor' operation. + + False = id(false), + ?line ?TrueGuard(is_record(#foo{}, foo, 5) xor False), + ?line ?FalseGuard(is_record(#foo{}, barf, 6) xor False), + ?line ?FalseGuard(is_record({foo}, foo, 5) xor False ), + + ?line ?TrueGuard(is_record(Foo, foo, 5) xor False), + ?line ?FalseGuard(is_record(Foo, barf, 6) xor False), + + + %% Implicit guards by using a list comprehension. + + List = id([1,#foo{a=2},3,#bar{d=4},5,#foo{a=6},7]), + + ?line [#foo{a=2},#foo{a=6}] = [X || X <- List, is_record(X, foo, 5)], + ?line [#bar{d=4}] = [X || X <- List, is_record(X, bar, 5)], + ?line [1,#foo{a=2},3,5,#foo{a=6},7] = + [X || X <- List, not is_record(X, bar, 5)], + ?line [1,3,5,7] = + [X || X <- List, ((not is_record(X, bar, 5)) and (not is_record(X, foo, 5)))], + ?line [#foo{a=2},#bar{d=4},#foo{a=6}] = + [X || X <- List, ((is_record(X, bar, 5)) or (is_record(X, foo, 5)))], + ?line [1,3,#bar{d=4}] = + [X || X <- List, ((is_record(X, bar, 5)) or (X < 5))], + + ?line MyList = [#foo{a=3},x,[],{a,b}], + ?line [#foo{a=3}] = [X || X <- MyList, is_record(X, foo, 5)], + ?line [x,[],{a,b}] = [X || X <- MyList, not is_record(X, foo, 5)], + ?line [#foo{a=3}] = [X || X <- MyList, begin is_record(X, foo, 5) end], + ?line [x,[],{a,b}] = [X || X <- MyList, begin not is_record(X, foo, 5) end], + ?line [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, is_record(X, foo, 5) or + not is_binary(X)], + ?line [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, not is_record(X, foo, 5) or + not is_binary(X)], + ?line [#foo{a=3}] = [X || X <- MyList, is_record(X, foo) or is_reference(X)], + ?line [x,[],{a,b}] = [X || X <- MyList, not is_record(X, foo) or + is_reference(X)], + ?line [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, + begin is_record(X, foo, 5) or + not is_binary(X) end], + ?line [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, + begin not is_record(X, foo, 5) or + not is_binary(X) end], + ?line [#foo{a=3}] = [X || X <- MyList, + begin is_record(X, foo, 5) or is_reference(X) end], + ?line [x,[],{a,b}] = [X || X <- MyList, + begin not is_record(X, foo, 5) or + is_reference(X) end], + + %% Update several fields with a string literal. + ?line #barf{} = Barf0 = id(#barf{}), + ?line Barf = update_barf(Barf0), + ?line #barf{a="abc",b=1} = id(Barf), + + %% Non-literal arguments. + ?line true = is_record(id(#barf{}), id(barf), id(6)), + ?line false = is_record(id(#barf{}), id(barf), id(42)), + ?line false = is_record(id(#barf{}), id(foo), id(6)), + + ok. + +record_access_in_guards(Config) when is_list(Config) -> + ?line Priv = ?config(priv_dir, Config), + ?line file:set_cwd(test_lib:get_data_dir(Config)), + ?line Opts0 = [{outdir,Priv},report_errors|test_lib:opt_opts(?MODULE)], + M = record_access_in_guards, + + Opts = [strict_record_tests|Opts0], + ?line io:format("Options: ~p\n", [Opts]), + ?line {ok,M} = c:c(M, Opts), + ?line ok = M:t(), + ok. + + +%% Test optimization of record access and is_record/2 in guards. + +-record(r, {a = 4,b}). +-record(r1, {a,b}). +-record(r2, {a = #r1{},b,c=length([1,2,3])}). +-record(r3, {a = fun(_) -> #r1{} end(1), b}). + +guard_opt(Config) when is_list(Config) -> + ok = fun() -> + F = fun(F, [H,H|T]) when is_record(H, r) -> + [H|F(F, T)]; + (F, [H|T]) when is_record(H, r) -> + [H|F(F, T)]; + (_, []) -> [] + end, + [#r{a=4,b=7},#r{a=1,b=42}] = + F(F, [#r{a=4,b=7},#r{a=4,b=7},#r{a=1,b=42}]), + {'EXIT',_} = (catch F(F, [#r1{}])), + ok + end(), + + true = fun() -> + R = #r{}, + if is_record(R, r) -> true; true -> false end + end(), + + ok = fun() -> + F = fun(true, B) when B#r1.a -> ok; + (false, _) -> error + end, + ok = F(true, #r1{a=true}), + error = F(false, anything_goes), + {'EXIT',_} = (catch F(true, #r1{})), + {'EXIT',_} = (catch F(true, #r{})), + ok + end(), + + ok = fun() -> + F = fun([{a,R}=T]) when R#r.a =:= 42 -> + {ok,tuple_size(T)}; + ([{a,R}=T]) when R#r1.a =:= 7 -> + {ok,tuple_size(T)}; + (_) -> error + end, + {ok,2} = F([{a,#r{a=42}}]), + {ok,2} = F([{a,#r1{a=7}}]), + error = F([{a,#r1{}}]), + error = F({a,b,c}), + error = F([]), + ok + end(), + + ok = fun() -> + F = fun(X, Y, Z) when is_record(X, r1) andalso + (is_record(Y, r2) orelse + is_record(Z, r3)) -> true; + (_, _, _) -> false + end, + true = F(#r1{}, #r2{}, #r3{}), + true = F(#r1{}, #r2{}, blurf), + true = F(#r1{}, blurf, #r3{}), + false = F(#r1{}, blurf, blurf), + false = F(blurf, #r2{}, #r3{}), + false = F(blurf, #r2{}, blurf), + false = F(blurf, blurf, #r3{}), + false = F(blurf, blurf, blurf), + ok + end(), + + ok = fun() -> + F = fun(R=#r{a=42}) when R#r.b =:= 7 -> + {ok,R}; + (_) -> error + end, + {ok,#r{a=42,b=7}} = F(#r{a=42,b=7}), + error = F(#r{}), + error = F([a,b,c]), + ok + end(), + + ok. + +update_barf(R) -> + R#barf{a="abc",b=1}. + +eval_once(Config) when is_list(Config) -> + ?line once(fun(GetRec) -> + true = erlang:is_record(GetRec(), foo) + end, #foo{}), + ?line once(fun(GetRec) -> + (GetRec())#foo{a=1} + end, #foo{}), + ?line once(fun(GetRec) -> + (GetRec())#foo{a=1,b=2} + end, #foo{}), + ?line once(fun(GetRec) -> + (GetRec())#foo{a=1,b=2,c=3} + end, #foo{}), + ?line once(fun(GetRec) -> + (GetRec())#foo{a=1,b=2,c=3,d=4} + end, #foo{}), + ok. + +once(Test, Record) -> + put(?MODULE, 0), + GetRec = fun() -> + put(?MODULE, 1+get(?MODULE)), + Record + end, + Result = Test(GetRec), + case get(?MODULE) of + 1 -> ok; + N -> + io:format("Evaluated ~w times\n", [N]), + ?t:fail() + end, + Result. + +%% Thanks to Martin Bjorklund. + +-record(foobar, {status}). + +foobar(Config) when is_list(Config) -> + {ok,_,_} = x({foo, 1}), + ok. + +get_bar() -> + #foobar{status = 1}. + +x(Trans) -> + {foo, Barno} = Trans, + case get_bar() of + Bar when Bar#foobar.status == 1 -> + noop(Bar), + Bar33 = Bar#foobar{status = 1}, + {ok, Bar33, Barno}; + _ -> + Trans + end. + +noop(_) -> + ok. + +-record(foo_rec, + {foo_1, + foo_2 = 0, + foo_3 = 0}). + +missing_test_heap(Config) when is_list(Config) -> + #foo_rec{foo_2=2,foo_3=5} = missing_test_heap_1(#foo_rec{foo_2=1,foo_3=4}), + ok. + + +%% Two test_heap instructions would be incorrectly merged (not allowed +%% because of gc_bif instructions for addition). +missing_test_heap_1(A = #foo_rec {foo_1 = _B, + foo_3 = C, + foo_2 = D}) -> + A#foo_rec {foo_1 = {C, D}, + foo_3 = C + 1, + foo_2 = D + 1}. + +id(I) -> I. -- cgit v1.2.3