1: %%
    2: %% %CopyrightBegin%
    3: %% 
    4: %% Copyright Ericsson AB 2005-2013. All Rights Reserved.
    5: %% 
    6: %% The contents of this file are subject to the Erlang Public License,
    7: %% Version 1.1, (the "License"); you may not use this file except in
    8: %% compliance with the License. You should have received a copy of the
    9: %% Erlang Public License along with this software. If not, it can be
   10: %% retrieved online at http://www.erlang.org/.
   11: %% 
   12: %% Software distributed under the License is distributed on an "AS IS"
   13: %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
   14: %% the License for the specific language governing rights and limitations
   15: %% under the License.
   16: %% 
   17: %% %CopyrightEnd%
   18: %%
   19: 
   20: -module(send_term_SUITE).
   21: 
   22: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
   23: 	 init_per_group/2,end_per_group/2,basic/1]).
   24: -export([init_per_testcase/2,end_per_testcase/2]).
   25: 
   26: -export([generate_external_terms_files/1]).
   27: 
   28: -include_lib("test_server/include/test_server.hrl").
   29: 
   30: init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
   31:     Dog=?t:timetrap(?t:minutes(3)),
   32:     [{watchdog, Dog}|Config].
   33: 
   34: end_per_testcase(_Func, Config) ->
   35:     Dog=?config(watchdog, Config),
   36:     ?t:timetrap_cancel(Dog).
   37: 
   38: suite() -> [{ct_hooks,[ts_install_cth]}].
   39: 
   40: all() -> 
   41:     [basic].
   42: 
   43: groups() -> 
   44:     [].
   45: 
   46: init_per_suite(Config) ->
   47:     Config.
   48: 
   49: end_per_suite(_Config) ->
   50:     ok.
   51: 
   52: init_per_group(_GroupName, Config) ->
   53:     Config.
   54: 
   55: end_per_group(_GroupName, Config) ->
   56:     Config.
   57: 
   58: 
   59: basic(Config) when is_list(Config) ->
   60:     Drv = "send_term_drv",
   61:     ?line P = start_driver(Config, Drv),
   62: 
   63:     ?line [] = term(P, 0),
   64:     ?line Self = self(),
   65:     ?line {blurf,42,[],[-42,{}|"abc"++P],"kalle",3.1416,Self} = term(P, 1),
   66:     ?line Deep = lists:seq(0, 199),
   67:     ?line Deep = term(P, 2),
   68:     ?line {B1,B2} = term(P, 3),
   69:     ?line B1 = list_to_binary(lists:seq(0, 255)),
   70:     ?line B2 = list_to_binary(lists:seq(23, 255-17)),
   71: 
   72:     %% Pid sending. We need another process.
   73:     ?line Child = spawn_link(fun() ->
   74: 				     erlang:port_command(P, [4])
   75: 			     end),
   76:     ?line {Self,Child} = receive_any(),
   77: 
   78:     %% ERL_DRV_EXT2TERM
   79:     ?line ExpectExt2Term = expected_ext2term_drv(?config(data_dir, Config)),
   80:     ?line ExpectExt2Term = term(P, 5),
   81: 
   82:     %% ERL_DRV_INT, ERL_DRV_UINT
   83:     ?line case erlang:system_info({wordsize, external}) of
   84: 	      4 ->
   85: 		  ?line {-1, 4294967295} = term(P, 6);
   86: 	      8 ->
   87: 		  ?line {-1, 18446744073709551615} = term(P, 6)
   88: 	  end,
   89: 
   90:     %% ERL_DRV_BUF2BINARY
   91:     ?line ExpectedBinTup = {<<>>,
   92: 			    <<>>,
   93: 			    list_to_binary(lists:duplicate(17,17)),
   94: 			    list_to_binary(lists:duplicate(1024,17))},
   95:     ?line ExpectedBinTup = term(P, 7),
   96: 
   97:     %% single terms
   98:     Singles = [{[], 8}, % ERL_DRV_NIL
   99:                {'', 9}, % ERL_DRV_ATOM
  100:                {an_atom, 10}, % ERL_DRV_ATOM
  101:                {-4711, 11}, % ERL_DRV_INT
  102:                {4711, 12}, % ERL_DRV_UINT
  103:                {P, 13}, % ERL_DRV_PORT
  104:                {<<>>, 14}, % ERL_DRV_BINARY
  105:                {<<"hejsan">>, 15}, % ERL_DRV_BINARY
  106:                {<<>>, 16}, % ERL_DRV_BUF2BINARY
  107:                {<<>>, 17}, % ERL_DRV_BUF2BINARY
  108:                {<<"hoppsan">>, 18}, % ERL_DRV_BUF2BINARY
  109:                {"", 19}, % ERL_DRV_STRING
  110:                {"", 20}, % ERL_DRV_STRING
  111:                {"hippsan", 21}, % ERL_DRV_STRING
  112:                {{}, 22}, % ERL_DRV_TUPLE
  113:                {[], 23}, % ERL_DRV_LIST
  114:                {Self, 24}, % ERL_DRV_PID
  115:                {[], 25}, % ERL_DRV_STRING_CONS
  116:                {[], 27}, % ERL_DRV_EXT2TERM
  117:                {18446744073709551615, 28}, % ERL_DRV_UINT64
  118:                {20233590931456, 29}, % ERL_DRV_UINT64
  119:                {4711, 30}, % ERL_DRV_UINT64
  120:                {0, 31}, % ERL_DRV_UINT64
  121:                {9223372036854775807, 32}, % ERL_DRV_INT64
  122:                {20233590931456, 33}, % ERL_DRV_INT64
  123:                {4711, 34}, % ERL_DRV_INT64
  124:                {0, 35}, % ERL_DRV_INT64
  125:                {-1, 36}, % ERL_DRV_INT64
  126:                {-4711, 37}, % ERL_DRV_INT64
  127:                {-20233590931456, 38}, % ERL_DRV_INT64
  128:                {-9223372036854775808, 39}], % ERL_DRV_INT64
  129:     ?line {Terms, Ops} = lists:unzip(Singles),
  130:     ?line Terms = term(P,Ops),
  131: 
  132:     AFloat = term(P, 26), % ERL_DRV_FLOAT
  133:     ?line true = AFloat < 0.001,
  134:     ?line true = AFloat > -0.001,
  135: 
  136:     %% Failure cases.
  137:     ?line [] = term(P, 127),
  138:     ?line receive
  139: 	      Any ->
  140: 		  ?line io:format("Unexpected: ~p\n", [Any]),
  141: 		  ?line ?t:fail()
  142: 	  after 0 ->
  143: 		  ok
  144: 	  end,
  145: 
  146:     ?line ok = chk_temp_alloc(),
  147: 
  148:     %% In a private heap system, verify that there are no binaries
  149:     %% left for the process.
  150:     ?line erlang:garbage_collect(),		%Get rid of binaries.
  151:     case erlang:system_info(heap_type) of
  152: 	private ->
  153: 	    ?line {binary,[]} = process_info(self(), binary);
  154: 	_ -> ok
  155:     end,
  156: 
  157:     ?line stop_driver(P, Drv),
  158:     ok.
  159: 
  160: term(P, Op) ->
  161:     erlang:port_command(P, [Op]),
  162:     receive_any().
  163: 
  164: receive_any() ->
  165:     receive
  166: 	Any -> Any
  167:     end.
  168: 
  169: chk_temp_alloc() ->
  170:     case erlang:system_info({allocator,temp_alloc}) of
  171: 	false ->
  172: 	    %% Temp alloc is not enabled
  173: 	    ?line ok;
  174: 	TIL ->
  175: 	    %% Verify that we havn't got anything allocated by temp_alloc
  176: 	    lists:foreach(
  177: 	      fun ({instance, _, TI}) ->
  178: 		      ?line {value, {mbcs, MBCInfo}}
  179: 			  = lists:keysearch(mbcs, 1, TI),
  180: 		      ?line {value, {blocks, 0, _, _}}
  181: 			  = lists:keysearch(blocks, 1, MBCInfo),
  182: 		      ?line {value, {sbcs, SBCInfo}}
  183: 			  = lists:keysearch(sbcs, 1, TI),
  184: 		      ?line {value, {blocks, 0, _, _}}
  185: 			  = lists:keysearch(blocks, 1, SBCInfo)
  186: 	      end,
  187: 	      TIL),
  188: 	    ?line ok
  189:     end.
  190: 	    
  191: 
  192: %% Start/stop drivers.
  193: start_driver(Config, Name) ->
  194:     Path = ?config(data_dir, Config),
  195:     erl_ddll:start(),
  196:     ok = load_driver(Path, Name),
  197:     open_port({spawn, Name}, []).
  198: 
  199: load_driver(Dir, Driver) ->
  200:     case erl_ddll:load_driver(Dir, Driver) of
  201: 	ok -> ok;
  202: 	{error, Error} = Res ->
  203: 	    io:format("~s\n", [erl_ddll:format_error(Error)]),
  204: 	    Res
  205:     end.
  206: 
  207: stop_driver(Port, Name) ->
  208:     ?line true = erlang:port_close(Port),
  209:     receive
  210: 	{Port,Message} ->
  211: 	    ?t:fail({strange_message_from_port,Message})
  212:     after 0 ->
  213: 	    ok
  214:     end,
  215: 
  216:     %% Unload the driver.
  217:     ok = erl_ddll:unload_driver(Name),
  218:     ?line ok = erl_ddll:stop().
  219: 
  220: get_external_terms(DataDir) ->    
  221:     {ok, Bin} = file:read_file([DataDir, "ext_terms.bin"]),
  222:     binary_to_term(Bin).
  223: 
  224: expected_ext2term_drv(DataDir) ->
  225:     make_expected_ext2term_drv(get_external_terms(DataDir)).
  226: 
  227: make_expected_ext2term_drv([]) ->
  228:     [];
  229: make_expected_ext2term_drv([T|Ts]) ->
  230:     [{T, T} | make_expected_ext2term_drv(Ts)].
  231: 
  232: %%
  233: %% Generation of send_term_SUITE_data/ext_terms.h and
  234: %% send_term_SUITE_data/ext_terms.bin
  235: %%
  236: %% These files should normally not need to be regenerated,
  237: %% but we may want that if we introduce new types or make
  238: %% backward incompatible changes to the external format.
  239: %%
  240: 
  241: generate_external_terms_files(BaseDir) ->
  242:     {ok,Node} = slave:start(hostname(), a_node),
  243:     RPid = rpc:call(Node, erlang, self, []),
  244:     true = is_pid(RPid),
  245:     RRef = rpc:call(Node, erlang, make_ref, []),
  246:     true = is_reference(RRef),
  247:     RPort = hd(rpc:call(Node, erlang, ports, [])),
  248:     true = is_port(RPort),
  249:     slave:stop(Node),
  250:     Terms =
  251: 	[{4711, -4711, [an_atom, "a list"]},
  252: 	 [1000000000000000000000,-1111111111111111, "blupp!", blipp],
  253: 	 {RPid, {RRef, RPort}, self(), hd(erlang:ports()), make_ref()},
  254: 	 {{}, [], [], fun () -> ok end, <<"hej hopp trallalaaaaaaaaaaaaaaa">>},
  255: 	 [44444444444444444444444,-44444444444, "b!", blippppppp],
  256: 	 {4711, RPid, {RRef, RPort}, -4711, [an_atom, "a list"]},
  257: 	 {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())},
  258: 	 {4711, -4711, [an_atom, "a list"]},
  259: 	 {4711, -4711, [atom, "list"]},
  260: 	 {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())},
  261: 	 {4444444444444444444,-44444, {{{{{{{{{{{{}}}}}}}}}}}}, make_ref()},
  262: 	 {444444444444444444444,-44444, [[[[[[[[[[[1]]]]]]]]]]], make_ref()},
  263: 	 {444444444444444444,-44444, {{{{{{{{{{{{2}}}}}}}}}}}}, make_ref()},
  264: 	 {4444444444444444444444,-44444, {{{{{{{{{{{{3}}}}}}}}}}}}, make_ref()},
  265: 	 {44444444444444444444,-44444, {{{{{{{{{{{{4}}}}}}}}}}}}, make_ref()},
  266: 	 {4444444444444444,-44444, [[[[[[[[[[[5]]]]]]]]]]], make_ref()},
  267: 	 {444444444444444444444,-44444, {{{{{{{{{{{{6}}}}}}}}}}}}, make_ref()},
  268: 	 {444444444444444,-44444, {{{{{{{{{{{{7}}}}}}}}}}}}, make_ref()},
  269: 	 {4444444444444444444,-44444, {{{{{{{{{{{{8}}}}}}}}}}}}, make_ref()}],
  270:     ok = file:write_file(filename:join([BaseDir,
  271: 					"send_term_SUITE_data",
  272: 					"ext_terms.bin"]),
  273: 			 term_to_binary(Terms, [compressed])),
  274:     {ok, IoDev} = file:open(filename:join([BaseDir,
  275: 					   "send_term_SUITE_data",
  276: 					   "ext_terms.h"]),
  277: 			    [write]),
  278:     write_ext_terms_h(IoDev, Terms),
  279:     file:close(IoDev).
  280: 
  281: write_ext_terms_h(IoDev, Terms) ->
  282:     write_license(IoDev),
  283:     io:format(IoDev, "#ifndef EXT_TERMS_H__~n",[]),
  284:     io:format(IoDev, "#define EXT_TERMS_H__~n",[]),
  285:     {ExtTerms, MaxSize} = make_ext_terms(Terms),
  286:     io:format(IoDev,
  287: 	      "static struct {~n"
  288: 	      "  unsigned char ext[~p];~n"
  289: 	      "  int ext_size;~n"
  290: 	      "  unsigned char cext[~p];~n"
  291: 	      "  int cext_size;~n"
  292: 	      "} ext_terms[] = {~n",[MaxSize, MaxSize]),
  293:     E = write_ext_terms_h(IoDev, ExtTerms, 0),
  294:     io:format(IoDev, "};~n",[]),
  295:     io:format(IoDev, "#define NO_OF_EXT_TERMS ~p~n", [E]),
  296:     io:format(IoDev, "#endif~n",[]).
  297: 
  298: make_ext_terms([]) ->
  299:     {[], 0};
  300: make_ext_terms([T|Ts]) ->
  301:     E = term_to_binary(T),
  302:     ESz = size(E),
  303:     CE = term_to_binary(T, [compressed]),
  304:     CESz = size(CE),
  305:     true = CESz =< ESz, % Assertion
  306:     {ExtTerms, MaxSize} = make_ext_terms(Ts),
  307:     NewMaxSize = case MaxSize < ESz of
  308: 		     true -> ESz;
  309: 		     false -> MaxSize
  310: 		 end,
  311:     {[{E, ESz, CE, CESz} | ExtTerms], NewMaxSize}.
  312: 
  313: write_ext_terms_h(IoDev, [], N) ->
  314:     io:format(IoDev, "~n",[]),
  315:     N;
  316: write_ext_terms_h(IoDev, [ET|ETs], 0) ->
  317:     write_ext_term(IoDev, ET),
  318:     write_ext_terms_h(IoDev, ETs, 1);
  319: write_ext_terms_h(IoDev, [ET|ETs], N) ->
  320:     io:format(IoDev, ",~n",[]),
  321:     write_ext_term(IoDev, ET),
  322:     write_ext_terms_h(IoDev, ETs, N+1).
  323: 
  324: write_ext_term(IoDev, {E, ESz, CE, CESz}) ->
  325:     ESz = write_bytes(IoDev, "  {{", binary_to_list(E), 0),
  326:     io:format(IoDev,
  327: 	      ",~n"
  328: 	      "   ~p,~n",
  329: 	      [ESz]),
  330:     CESz = write_bytes(IoDev, "   {", binary_to_list(CE), 0),
  331:     io:format(IoDev,
  332: 	      ",~n"
  333: 	      "   ~p}",
  334: 	      [CESz]).
  335: 
  336: write_bytes(IoDev, _, [], N) ->
  337:     io:format(IoDev, "}",[]),
  338:     N;
  339: write_bytes(IoDev, Prefix, [B|Bs], N) ->
  340:     io:format(IoDev, "~s~w", [Prefix, B]),
  341:     write_bytes(IoDev, ",", Bs, N+1).
  342: 
  343: write_license(IoDev) ->
  344:     S =	"/* ``The contents of this file are subject to the Erlang Public License,~n"
  345: 	" * Version 1.1, (the \"License\"); you may not use this file except in~n"
  346: 	" * compliance with the License. You should have received a copy of the~n"
  347: 	" * Erlang Public License along with this software. If not, it can be~n"
  348: 	" * retrieved via the world wide web at http://www.erlang.org/.~n"
  349: 	" * ~n"
  350: 	" * Software distributed under the License is distributed on an \"AS IS\"~n"
  351: 	" * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See~n"
  352: 	" * the License for the specific language governing rights and limitations~n"
  353: 	" * under the License.~n"
  354: 	" * ~n"
  355: 	" * The Initial Developer of the Original Code is Ericsson AB.~n"
  356: 	" * Portions created by Ericsson are Copyright 2007, Ericsson AB.~n"
  357: 	" * All Rights Reserved.''~n"
  358: 	" * ~n"
  359: 	" *     $Id$~n"
  360: 	" */~n"
  361: 	"~n"
  362: 	"/*~n"
  363: 	" * Do not modify this file. This file and ext_terms.bin were~n"
  364: 	" * automatically generated by send_term_SUITE:generate_external_terms_files/1~n"
  365: 	" * and needs to be consistent with each other.~n"
  366: 	" */~n",
  367:     io:format(IoDev, S, []).
  368: 
  369: 
  370: hostname() ->    
  371:     hostname(atom_to_list(node())).
  372: 
  373: hostname([$@ | Hostname]) ->
  374:     list_to_atom(Hostname);
  375: hostname([_C | Cs]) ->
  376:     hostname(Cs).