Permalink
Browse files

erlv8 + classifer test

  • Loading branch information...
1 parent c316a9f commit 14dcc822758b8f7b898e069a560ebc94be2ccba1 @chengxingyu123 chengxingyu123 committed Mar 2, 2012
View
1 .gitignore
@@ -1,4 +1,3 @@
-*.beam
*.class
workspaces
bin
View
3 org.erlide.kernel.ide/.settings/org.erlide.core.prefs
@@ -1,8 +1,9 @@
+#Fri Mar 02 14:13:01 CST 2012
backend_version=R15B
eclipse.preferences.version=1
external_includes=
external_modules=
include_dirs=include
output_dir=ebin
-source_dirs=src/test;src/exago/sample_logs;src/exago/sample_examples;src/exago/splitter_type;src/exago/field_type;src/exago;src/utils;src/UI;src/siteview;src/experiment;src/exat;src;src/erl_debugger;src/parsing;src/pprint;src/syntax
+source_dirs=src/test;src/exago/sample_logs;src/exago/sample_examples;src/exago/splitter_type;src/exago/field_type;src/exago;src/utils;src/UI;src/siteview;src/experiment;src/exat;src;src/erl_debugger;src/parsing;src/pprint;src/syntax;src/erlv8
use_pathz=false
View
17 org.erlide.kernel.ide/include/erlv8.hrl
@@ -0,0 +1,17 @@
+-record(erlv8_fun_invocation, {
+ is_construct_call = false,
+ holder,
+ this,
+ ref,
+ vm,
+ ctx
+ }).
+
+-define(V8Obj(X),erlv8_object:new(X)).
+-define(V8Arr(X),erlv8_array:new(X)).
+
+-record(erlv8_object, { resource, vm }).
+-record(erlv8_fun, { resource, vm }).
+-record(erlv8_array, { resource, vm }).
+
+
View
2 org.erlide.kernel.ide/run.bat
@@ -1 +1 @@
-erl -sname master -setcookie erlide -pa ebin/ -pa ../org.erlide.kernel.common/ebin -boot start_sasl -env ERL_MAX_ETS_TABLES 1000000 +P 10000000 -s object
+erl -sname master -setcookie erlide -pa ebin/ -pa ../org.erlide.kernel.common/ebin -boot start_sasl -env ERL_MAX_ETS_TABLES 1000000 +P 10000000 -s object -eval "application:start(erlv8)"
View
13 org.erlide.kernel.ide/src/erlv8/erlv8.app.src
@@ -0,0 +1,13 @@
+{application, erlv8,
+ [
+ {description, "Erlang V8 interface"},
+ {vsn, git},
+ {registered, []},
+ {modules, [erlv8, erlv8_app, erlv8_fun, erlv8_object, erlv8_context, erlv8_array, erlv8_module, erlv8_fun_invocation, erlv8_vm, erlv8_nif, erlv8_extern, erlv8_sup]},
+ {applications, [
+ kernel,
+ stdlib
+ ]},
+ {mod, { erlv8_app, []}},
+ {env, []}
+ ]}.
View
831 org.erlide.kernel.ide/src/erlv8/erlv8.erl
@@ -0,0 +1,831 @@
+-module(erlv8).
+-export([start/0,stop/0]).
+-include_lib("../include/erlv8.hrl").
+
+start() ->
+ application:start(erlv8).
+
+stop() ->
+ application:stop(erlv8).
+
+%% TESTS
+-include_lib("eunit/include/eunit.hrl").%
+-ifdef(TEST).
+
+suppress_kernel_logger_test() ->
+ % not a test, obviously
+ error_logger:delete_report_handler(error_logger_tty_h).
+
+valid_vm_creation_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assert(is_pid(VM)),
+ ?assertEqual({ok, 2}, erlv8_vm:run(VM,"1+1;")),
+ ok = stop().
+
+few_vms_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assertEqual({ok,2}, erlv8_vm:run(VM,"1+1;")),
+ ?assertEqual({ok,4}, erlv8_vm:run(VM,"2*2;")),
+ stop().
+
+
+compilation_error_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assertMatch({throw, _}, erlv8_vm:run(VM,"1+;")),
+ stop().
+
+vm_stopping_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ erlv8_vm:stop(VM),
+ timer:sleep(100), %% allow time for process to stop
+ ?assertEqual(false,erlang:is_process_alive(VM)),
+ stop().
+
+vm_global_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ erlv8_vm:run(VM,"var a = 1+1;"),
+ Global = erlv8_vm:global(VM),
+ ?assertEqual([{<<"a">>,2}],Global:proplist()),
+ stop().
+
+vm_set_global_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("a",1),
+ erlv8_vm:run(VM,"var b = a+1;"),
+ ?assertEqual([{<<"a">>,1},{<<"b">>,2}],Global:proplist()),
+ stop().
+
+term_to_js_string_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Obj = erlv8_vm:taint(VM, "abc"),
+ ?assertEqual(<<"abc">>,Obj),
+ stop().
+
+term_to_js_binary_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Obj = erlv8_vm:taint(VM, <<"abc">>),
+ ?assertEqual(<<"abc">>,Obj),
+ stop().
+
+term_to_js_iolist_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Obj = erlv8_vm:taint(VM, [<<"abc">>,$d,"ef"]),
+ ?assertEqual(<<"abcdef">>,Obj),
+ stop().
+
+term_to_js_object_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Obj = erlv8_vm:taint(VM,?V8Obj([{"a",1},{"b","c"},{<<"c">>,<<"d">>}])),
+ ?assertMatch([{<<"a">>,1},{<<"b">>,<<"c">>},{<<"c">>,<<"d">>}],Obj:proplist()),
+ stop().
+
+term_to_js_boolean_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assertEqual(true, erlv8_vm:taint(VM,true)),
+ ?assertEqual(false, erlv8_vm:taint(VM,false)),
+ stop().
+
+term_to_js_atom_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assertEqual(<<"a">>, erlv8_vm:taint(VM,a)),
+ ?assertEqual(<<"b">>, erlv8_vm:taint(VM,b)),
+ stop().
+
+term_to_js_undefined_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assertEqual(undefined, erlv8_vm:taint(VM,undefined)),
+ stop().
+
+term_to_js_ok_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assertEqual(true, erlv8_vm:taint(VM,ok)),
+ stop().
+
+term_to_js_null_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assertEqual(null, erlv8_vm:taint(VM,null)),
+ stop().
+
+term_to_js_number_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Nums = [2147483648,-2147483649,1,4294967296,4294967297,3.555],
+ [ ?assertEqual(N, erlv8_vm:taint(VM,N)) || N <- Nums ],
+ stop().
+
+term_to_js_array_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ A1 = erlv8_vm:taint(VM,?V8Arr([1,2,3])),
+ ?assertEqual([1,2,3],A1:list()),
+ A2 = erlv8_vm:taint(VM,?V8Arr([])),
+ ?assertEqual([],A2:list()),
+ stop().
+
+term_to_js_pid_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assertEqual(self(), erlv8_vm:taint(VM,self())),
+ ?assertEqual(self(), erlv8_vm:taint(VM,self())), % the second call is to ensure memory is managed properly (regression)
+ stop().
+
+term_to_js_ref_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Ref = make_ref(),
+ ?assertEqual(Ref, erlv8_vm:taint(VM,Ref)),
+ stop().
+
+term_to_js_unsupported_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assertEqual(undefined,erlv8_vm:taint(VM,{this_tuple,is_not_supported})),
+ stop().
+
+term_to_js_object_invalid_proplist_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assertEqual(undefined, erlv8_vm:taint(VM,?V8Obj([{"a",1},{b,2},{3,4}]))),
+ stop().
+
+
+js_to_term_fun_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ erlv8_vm:run(VM,"x = function () {}"),
+ Global = erlv8_vm:global(VM),
+ #erlv8_fun{vm=VM} = Global:get_value("x"),
+ stop().
+
+js_object_to_term_fun_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ erlv8_vm:run(VM,"x = function () {}; x.a = 1"),
+ Global = erlv8_vm:global(VM),
+ X = Global:get_value("x"),
+ O = X:object(),
+ ?assertEqual([{<<"a">>,1}],O:proplist()),
+ stop().
+
+term_to_js_object_fun_erlv8_fun_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ {ok, #erlv8_fun{vm=VM}=Fun} = erlv8_vm:run(VM,"x = function () {}; x.a = 1; x"),
+ O = Fun:object(),
+ ?assertEqual([{<<"a">>,1}],O:proplist()),
+ Global:set_value("y",Fun),
+ Y = Global:get_value("y"),
+ YObj = Y:object(),
+ ?assertEqual(1, YObj:get_value("a")),
+ stop().
+
+term_to_js_object_fun_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("x",fun (#erlv8_fun_invocation{},[]) -> 123 end),
+ X = Global:get_value("x"),
+ XObj = X:object(),
+ XObj:set_value("y",1),
+ ?assertMatch({ok, 1}, erlv8_vm:run(VM,"x.y")),
+ X0 = Global:get_value("x"), X1 = X0:object(),
+ ?assertMatch(1, X1:get_value("y")),
+ ?assertMatch({ok, 123}, erlv8_vm:run(VM,"x()")),
+ stop().
+
+term_to_js_error_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("x",fun (#erlv8_fun_invocation{},[]) -> {throw, {error, "Hello"}} end),
+ {throw, Exception} = erlv8_vm:run(VM,"x()"),
+ ?assertEqual(<<"Hello">>, Exception:get_value("message")),
+ Global:set_value("x",fun (#erlv8_fun_invocation{},[]) -> {throw, "Goodbye"} end),
+ {throw, <<"Goodbye">>} = erlv8_vm:run(VM,"x()"),
+ stop().
+
+object_fun_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ {ok, Fun} = erlv8_vm:run(VM,"f = function() {}; f.y = 1; f"),
+ FunObj = Fun:object(),
+ ?assertEqual([{<<"y">>,1}],FunObj:proplist()),
+ stop().
+
+fun_obj_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ F = erlv8_vm:taint(VM, erlv8_fun:new(fun (#erlv8_fun_invocation{},[]) -> 1 end, erlv8_object:new([{"a",1}]))),
+ FObj = F:object(),
+ ?assertEqual(1,FObj:get_value("a")),
+ stop().
+
+invocation_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("test", fun (#erlv8_fun_invocation{} = _Invocation,[]) -> 123 end),
+ ?assertEqual({ok, 123}, erlv8_vm:run(VM,"test()")),
+ stop().
+
+fun_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("test0", fun (#erlv8_fun_invocation{} = _Invocation, [F]) -> F:call([321]) end),
+ Global:set_value("test", fun (#erlv8_fun_invocation{} = _Invocation,[Val]) -> Val end),
+ ?assertEqual({ok, 321}, erlv8_vm:run(VM,"f = function(x) { return test(x) }; test0(f);")),
+ stop().
+
+
+erlang_fun_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("test", fun (#erlv8_fun_invocation{} = _Invocation,[Val]) -> Val end),
+ T = Global:get_value("test"),
+ ?assertEqual(321, T:call([321])),
+ stop().
+
+erlang_fun_call_on_this_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("test", fun (#erlv8_fun_invocation{} = _Invocation, []) -> 321 end),
+ ?assertEqual(321, (Global:get_value("test")):call(?V8Obj([]))),
+ stop().
+
+
+fun_fail_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("test", fun (#erlv8_fun_invocation{} = _Invocation,[Val]) -> Val end),
+ ?assertMatch({throw, _},erlv8_vm:run(VM,"test();")),
+ stop().
+
+fun_fail_inside_badmatch_test() -> %% TODO: cover all standard exits?
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("test", fun (#erlv8_fun_invocation{} = _Invocation,[Val]) -> ok = Val end),
+ ?assertMatch({throw, _}, erlv8_vm:run(VM,"test('help');")),
+ stop().
+
+
+fun_vm_is_pid_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("test", fun (#erlv8_fun_invocation{ vm = VM1 } = _Invocation,[]) -> is_pid(VM1) end),
+ ?assertEqual({ok, true}, erlv8_vm:run(VM,"test();")),
+ stop().
+
+fun_returning_fun_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("test", fun (#erlv8_fun_invocation{} = _Invocation,[Val]) -> Val end),
+ {ok, #erlv8_fun{vm=VM}=F} = erlv8_vm:run(VM,"f = function() {}; test(f);"),
+ O = F:object(),
+ ?assertEqual([],O:proplist()),
+ stop().
+
+fun_new_vm_inside_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("test", fun (#erlv8_fun_invocation{} = _Invocation,[]) -> {ok, _Pid} = erlv8_vm:start(), 321 end),
+ ?assertEqual({ok, 321},erlv8_vm:run(VM, "test()")),
+ stop().
+
+fun_this_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("x",fun (#erlv8_fun_invocation{}=I,[]) -> I:this() end),
+ {ok, Result} = erlv8_vm:run(VM,"x()"),
+ ?assertEqual(Global:proplist(), Result:proplist()),
+ stop().
+
+fun_is_construct_call_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("x",fun (#erlv8_fun_invocation{}=I,[]) -> I:is_construct_call() end),
+ ?assertEqual({ok, false}, erlv8_vm:run(VM,"x()")),
+ Global:set_value("x",fun (#erlv8_fun_invocation{ this = This }=I,[]) -> This:set_value("icc",I:is_construct_call()) end),
+ ?assertEqual({ok, true}, erlv8_vm:run(VM,"new x().icc")),
+ stop().
+
+fun_global_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("x",fun (#erlv8_fun_invocation{}=I,[]) ->
+ Global = I:global(),
+ Global:set_value("a",2)
+ end),
+ ?assertMatch([{<<"x">>, _}], Global:proplist()),
+ erlv8_vm:run(VM,"x()"),
+ ?assertMatch([{<<"x">>, _},{<<"a">>, 2}], Global:proplist()),
+ stop().
+
+fun_callback_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Self = self(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("test", fun (#erlv8_fun_invocation{} = _Invocation, [Cb]) ->
+ spawn(fun () ->
+ timer:sleep(1000), %% allow ample time
+ Self ! {ok, Cb:call([1])}
+ end),
+ undefined
+ end),
+
+ erlv8_vm:run(VM,"f = function(x) { return x}; test(f);"),
+ receive
+ {ok, 1} ->
+ ok;
+ Other1 ->
+ error({bad_result,Other1})
+ end,
+ stop().
+
+js_fun_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ erlv8_vm:run(VM,"f = function () { return 100; }"),
+ F = Global:get_value("f"),
+ ?assertEqual(100,F:call()),
+ erlv8_vm:run(VM,"f1 = function (x) { return x*100; }"),
+ F1 = Global:get_value("f1"),
+ ?assertEqual(200,F1:call([2])),
+ stop().
+
+js_fun_this_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ erlv8_vm:run(VM,"f = function (a) { this.x = a*100; }; y = {}"),
+ F = Global:get_value("f"),
+ Y = Global:get_value("y"),
+ F:call(Y,[1]),
+ ?assertEqual(100, Y:get_value("x")),
+ Y:call(F,[2]), % test another API
+ ?assertEqual(200, Y:get_value("x")),
+ stop().
+
+
+to_string_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assertEqual(<<"1">>,erlv8_vm:to_string(VM,1)),
+ ?assertEqual(<<"1">>,erlv8_vm:to_string(VM,"1")),
+ ?assertEqual(<<"true">>,erlv8_vm:to_string(VM,true)),
+ ?assertEqual(<<"[object Object]">>,erlv8_vm:to_string(VM,?V8Obj([{a,1}]))),
+ stop().
+
+to_detail_string_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assertEqual(<<"1">>,erlv8_vm:to_detail_string(VM,1)),
+ ?assertEqual(<<"1">>,erlv8_vm:to_detail_string(VM,"1")),
+ ?assertEqual(<<"true">>,erlv8_vm:to_detail_string(VM,true)),
+ ?assertEqual(<<"#<Object>">>,erlv8_vm:to_detail_string(VM,?V8Obj([{a,1}]))),
+ stop().
+
+proto_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("proto",erlv8_object:new([{"x",1}])),
+ Global:set_value("obj",erlv8_object:new([{"y",1}])),
+ Proto = Global:get_value("proto"),
+ Obj = Global:get_value("obj"),
+ ?assertEqual(true, Obj:set_prototype(Proto)),
+ ObjProto = Obj:get_prototype(),
+ ?assertEqual(Proto:proplist(),ObjProto:proplist()),
+ ?assertEqual({ok, 1},erlv8_vm:run(VM,"obj.x")),
+ stop().
+
+hidden_value_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_hidden_value("a",1),
+ ?assertEqual(1,Global:get_hidden_value("a")),
+ ?assertEqual({ok, undefined}, erlv8_vm:run(VM,"this.a")),
+ ?assertEqual(undefined, Global:get_hidden_value("shouldntbethere")),
+ stop().
+
+objects_equality_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("v1",?V8Obj([{"a",1}])),
+ Global:set_value("v2",?V8Obj([{"a",1}])),
+ V1 = Global:get_value("v1"),
+ V2 = Global:get_value("v2"),
+ ?assert(V1:equals(V1)),
+ ?assert(not V1:strict_equals(V2)),
+ erlv8_vm:run(VM,"f1 = function() { return 1; }; f2 = function() { return 2; };"),
+ F1 = Global:get_value("f1"),
+ F2 = Global:get_value("f2"),
+ ?assert(F1:equals(F1)),
+ ?assert(not F1:strict_equals(F2)),
+ stop().
+
+primitives_equality_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assert(erlv8_vm:equals(VM, 1,"1")),
+ ?assert(erlv8_vm:equals(VM, 1,1)),
+ ?assert(not erlv8_vm:equals(VM, 1,2)),
+ ?assert(not erlv8_vm:strict_equals(VM, 1,"1")),
+ ?assert(erlv8_vm:strict_equals(VM, 1,1)),
+ ?assert(not erlv8_vm:equals(VM, 1,2)),
+ stop().
+
+
+taint_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ ?assertMatch(#erlv8_object{},erlv8_vm:taint(VM, ?V8Obj([{"a",1}]))),
+ stop().
+
+implicit_taint_for_erlang_only_calls_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("x",fun (#erlv8_fun_invocation{},[#erlv8_object{vm = VM1}]) -> VM1 =/= undefined end),
+ X = Global:get_value("x"),
+ ?assert(X:call([?V8Obj([])])),
+ stop().
+
+fun_extends_object_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ {ok, F} = erlv8_vm:run(VM,"f = function() { return 1; }; f.x = 1; f"),
+ ?assertEqual(1, F:get_value("x")),
+ stop().
+
+array_length_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ A = erlv8_vm:taint(VM,?V8Arr([1,2,3])),
+ ?assertEqual(3,A:length()),
+ stop().
+
+array_subscript_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ A = erlv8_vm:taint(VM,?V8Arr([1,2,"a"])),
+ ?assertEqual(<<"a">>,A:get_value(2)),
+ A:set_value(1,"b"),
+ ?assertEqual(<<"b">>,A:get_value(1)),
+ stop().
+
+array_push_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ A = erlv8_vm:taint(VM,?V8Arr([1,2,3])),
+ A:push(4),
+ ?assertEqual([1,2,3,4],A:list()),
+ stop().
+
+array_unshift_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ A = erlv8_vm:taint(VM,?V8Arr([1,2,3])),
+ A:unshift(4),
+ ?assertEqual([4,1,2,3],A:list()),
+ stop().
+
+object_deletion_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ O = erlv8_vm:taint(VM,?V8Obj([{"a",1},{"b", 2}])),
+ O:delete("a"),
+ ?assertEqual(undefined, O:get_value("a")),
+ stop().
+
+array_deletion_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ A = erlv8_vm:taint(VM,?V8Arr([1,2,3])),
+ A:delete(0),
+ ?assertEqual([2,3], A:list()),
+ stop().
+
+vm_storage_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ erlv8_vm:stor(VM, {my_mod, data}, "Data"),
+ ?assertEqual("Data",erlv8_vm:retr(VM, {my_mod, data})),
+ stop().
+
+getter_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ true = Global:set_accessor("getter_value", fun (#erlv8_fun_invocation{} = _Invocation, [Prop]) ->
+ Prop
+ end),
+ ?assertEqual(<<"getter_value">>,Global:get_value("getter_value")),
+ stop().
+
+setter_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ true = Global:set_accessor("setter_value", fun (#erlv8_fun_invocation{ this = This } = _Invocation, [_Prop]) ->
+ This:get_value("val")
+ end,
+ fun (#erlv8_fun_invocation{ this = This } = _Invocation, [_Prop, Val]) ->
+ This:set_value("val",Val)
+ end, default, dontdelete),
+ Global:set_value("setter_value", 1),
+ ?assertEqual(1,Global:get_value("setter_value")),
+ Global:delete("setter_value"),
+ ?assertEqual(1,Global:get_value("setter_value")),
+ stop().
+
+run_new_ctx_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("x",1),
+ NewCtx = erlv8_context:new(VM),
+ NewGlobal = erlv8_context:global(NewCtx),
+ erlv8_vm:run(VM,NewCtx,"x={a:1}"),
+ T = NewGlobal:get_value("x"),
+ ?assertEqual(1,T:get_value("a")),
+ stop().
+
+run_multi_ctx_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("x",1),
+ NewCtx = erlv8_context:new(VM),
+ NewCtx1 = erlv8_context:new(VM),
+ erlv8_vm:run(VM,NewCtx,"x={a:1}"),
+ NewGlobal1 = erlv8_context:global(NewCtx1),
+ ?assertEqual(undefined,NewGlobal1:get_value("x")),
+ stop().
+
+ctx_fun_invocation_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ NewCtx = erlv8_context:new(VM),
+ NewGlobal = erlv8_context:global(NewCtx),
+ NewGlobal:set_value("f",fun (#erlv8_fun_invocation{}=I,[]) -> G= I:global(), G:set_value("x",1) end),
+ erlv8_vm:run(VM,NewCtx,"f()"),
+ ?assertEqual(1,NewGlobal:get_value("x")),
+ ?assertEqual(undefined,Global:get_value("x")),
+ stop().
+
+fun_call_exception_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ erlv8_vm:run(VM,"f = function () { throw('exc'); }"),
+ F = Global:get_value("f"),
+ ?assertEqual({throw, {error, <<"exc">>}}, F:call()),
+ stop().
+
+js_parallel_fun_call_test_() ->
+ {timeout, 10,
+ fun () ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ erlv8_vm:run(VM,"f = function (x) { return x }"),
+ F = Global:get_value("f"),
+ Self = self(),
+ lists:map(fun (N) ->
+ spawn(fun () -> X = F:call([N]), Self ! X end)
+ end, lists:seq(1,2)),
+ ?assertEqual(lists:seq(1,2),lists:usort(parallel_call_test_loop(2,[]))),
+ stop()
+ end}.
+
+erl_parallel_fun_call_test_() ->
+ {timeout, 10,
+ fun () ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("f",fun (#erlv8_fun_invocation{},[N]) -> N end),
+ F = Global:get_value("f"),
+ Self = self(),
+ lists:map(fun (N) ->
+ spawn(fun () -> X = F:call([N]), Self ! X end)
+ end, lists:seq(1,2)),
+ ?assertEqual(lists:seq(1,2),lists:usort(parallel_call_test_loop(2,[]))),
+ stop()
+ end}.
+
+parallel_call_test_loop(T,L) when length(L) == T ->
+ L;
+parallel_call_test_loop(T,L) ->
+ receive
+ N when is_integer(N) ->
+ parallel_call_test_loop(T,[N|L]);
+ Other ->
+ error({bad_result, Other})
+ end.
+
+property_attribute_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("a",1,dontdelete),
+ Global:set_value("b",1,readonly),
+ Global:set_value("c",1,[dontdelete,readonly]),
+ Global:delete("a"),
+ Global:set_value("b",2),
+ ?assertEqual(1,Global:get_value("a")),
+ ?assertEqual(1,Global:get_value("b")),
+ ?assertEqual(1,Global:get_value("c")),
+ Global:delete("c"),
+ ?assertEqual(1,Global:get_value("c")),
+ stop().
+
+instantiate_js_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ {ok, F} = erlv8_vm:run(VM,"f = function(y) { this.x = y}"),
+ O = F:instantiate([1]),
+ ?assertEqual(1,O:get_value("x")),
+ stop().
+
+instantiate_erl_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("f",fun (#erlv8_fun_invocation{ this = This },[Y]) -> This:set_value("x",Y) end),
+ F = Global:get_value("f"),
+ O = F:instantiate([1]),
+ ?assertEqual(1,O:get_value("x")),
+ stop().
+
+instantiate_erl_from_js_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("f",fun (#erlv8_fun_invocation{ this = This },[Y]) -> This:set_value("x",Y) end),
+ ?assertEqual({ok, 1}, erlv8_vm:run(VM,"new f(1).x")),
+ stop().
+
+throwing_object_as_an_error_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("f",fun (#erlv8_fun_invocation{},[]) -> {throw, ?V8Obj([{"a",1}])} end),
+ {throw, E} = erlv8_vm:run(VM,"f()"),
+ ?assertEqual(1,E:get_value("a")),
+ stop().
+
+v8_return_value_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("f",fun (#erlv8_fun_invocation{},[X]) -> X end),
+ F = Global:get_value("f"),
+ O = erlv8_vm:taint(VM, ?V8Obj([{"a",1}])),
+ O1 = F:call([O]),
+ ?assert(O:equals(O1)),
+ stop().
+
+clear_env_lockup_regression_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("f",fun (#erlv8_fun_invocation{},[X]) -> X end),
+ Global:set_value("f1",fun (#erlv8_fun_invocation{},[F]) -> F:call([1]) end),
+ ?assertEqual({ok, 1}, erlv8_vm:run(VM, "f1(f)")),
+ stop().
+
+extern_proto_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ lists:foreach(fun({Type, Val}) ->
+ Proto = erlv8_extern:get_proto(VM, Type),
+ Proto:set_value("toString", fun(#erlv8_fun_invocation{},[]) -> Type end),
+ Global:set_value("val", Val),
+ ?assertEqual({ok, atom_to_binary(Type, utf8)}, erlv8_vm:run(VM, "val.toString()"))
+ end, [{ref, make_ref()},
+ {pid, self()}]),
+ stop().
+
+externalize_proto_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Self = self(),
+ spawn(fun () -> Self ! open_port({spawn, "ls"},[stream]) end),
+ Port = receive
+ P -> P
+ end,
+ lists:foreach(fun(Val) ->
+ Global:set_value("val", erlv8_extern:extern(VM, Val)),
+ ?assertEqual(Val, Global:get_value("val"))
+ end, [1,
+ atom,
+ <<>>,
+ make_ref(),
+ fun() -> ok end,
+ Port,
+ self(),
+ {1,2,3, self()},
+ [1,2,{3,2,1}]]),
+ stop().
+
+internal_field_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ ?assertEqual(0,Global:internal_field_count()),
+ ?assertEqual(error, Global:get_internal_field(-1)),
+ ?assertEqual(error, Global:get_internal_field(0)),
+ ?assertEqual(error, Global:set_internal_field(0, 1)),
+
+ %% TODO: Externals don't have internal fields anymore, find another way to test this:
+ %% Extern = erlv8_extern:extern(VM, atom),
+
+ %% ?assertEqual(1,Extern:internal_field_count()),
+ %% ?assertEqual(error, Global:get_internal_field(1)),
+ %% ?assertEqual(error, Global:set_internal_field(1, 1)),
+
+ %% ?assertEqual(atom, Extern:get_internal_field(0)),
+
+ %% Extern:set_internal_field(0,yes),
+ %% ?assertEqual("yes", Extern:get_internal_field(0)),
+
+ %% Extern:set_internal_field(0,erlv8_extern:extern(VM, yes)),
+ %% ?assertEqual(yes, Extern:get_internal_field(0)),
+
+ %% Extern:set_internal_field(0,{extern, yes}),
+ %% ?assertEqual(yes, Extern:get_internal_field(0)),
+ stop().
+
+nested_result_tick_regression_test() ->
+ start(),
+ {ok, VM} = erlv8_vm:start(),
+ Global = erlv8_vm:global(VM),
+ Global:set_value("f1",fun (#erlv8_fun_invocation{},[]) -> register(erlv8_test_f1, self()), receive X -> X end end),
+ Global:set_value("f2",fun (#erlv8_fun_invocation{},[]) -> register(erlv8_test_f2, self()), receive X -> X end end),
+ Self = self(),
+ spawn(fun () ->
+ Self ! {f1, erlv8_vm:run(VM, "f1()")}
+ end),
+ spawn(fun () ->
+ Self ! {f2, erlv8_vm:run(VM, "f2()")}
+ end),
+ timer:sleep(200), %% give them some time to start (I know, I know)
+ %% so now the ticker should be in f2
+ %% but we'll return value for f1
+ erlv8_test_f1 ! 1,
+ %% and only then for f2
+ erlv8_test_f2 ! 2,
+ nested_result_tick_regression_test_loop([]),
+ stop().
+
+nested_result_tick_regression_test_loop([f1,f2]) ->
+ ok;
+nested_result_tick_regression_test_loop([f2,f1]) ->
+ ok;
+nested_result_tick_regression_test_loop(L) ->
+ receive
+ {f1, Result} ->
+ ?assertEqual({ok, 1}, Result),
+ nested_result_tick_regression_test_loop([f1|L]);
+ {f2, Result} ->
+ ?assertEqual({ok, 2}, Result),
+ nested_result_tick_regression_test_loop([f2|L])
+ end.
+
+-endif.
View
16 org.erlide.kernel.ide/src/erlv8/erlv8_app.erl
@@ -0,0 +1,16 @@
+-module(erlv8_app).
+
+-behaviour(application).
+
+%% Application callbacks
+-export([start/2, stop/1]).
+
+%% ===================================================================
+%% Application callbacks
+%% ===================================================================
+
+start(_StartType, _StartArgs) ->
+ erlv8_sup:start_link().
+
+stop(_State) ->
+ ok.
View
39 org.erlide.kernel.ide/src/erlv8/erlv8_array.erl
@@ -0,0 +1,39 @@
+-module(erlv8_array,[Resource,VM]).
+-extends(erlv8_object).
+-export([list/0,object/0,new/1, length/0, push/1, unshift/1, delete/1]).
+
+list() ->
+ erlv8_vm:enqueue_tick(VM,{list,Resource}).
+
+object() ->
+ erlv8_object:new(Resource,VM).
+
+new(O) ->
+ {erlv8_array, O, undefined}.
+
+length() ->
+ length(list()). %% TODO: I guess it will be more efficient if we had a NIF for that?
+
+push(Val) ->
+ M = {?BASE_MODULE, Resource, VM},
+ M:set_value(length(),Val).
+
+unshift(Val) ->
+ M = {?BASE_MODULE, Resource, VM},
+ L = length(),
+ lists:foreach(fun (I) ->
+ M:set_value(L-I,M:get_value(L-I-1))
+ end, lists:seq(0,L-1)),
+ M:set_value(0,Val).
+
+delete(Index) ->
+ M = {?BASE_MODULE, Resource, VM},
+ L = length(),
+ V = M:get_value(Index),
+ lists:foreach(fun (I) ->
+ M:set_value(I,M:get_value(I+1))
+ end, lists:seq(Index,L-1)),
+ M:set_value(length,L-1),
+ V.
+
+
View
13 org.erlide.kernel.ide/src/erlv8/erlv8_context.erl
@@ -0,0 +1,13 @@
+-module(erlv8_context).
+-export([get/1,global/1,new/1]).
+
+get(Server) ->
+ gen_server2:call(Server,context).
+
+new(Server) ->
+ gen_server2:call(Server,new_context).
+
+global({Server, Resource}) ->
+ gen_server2:call(Server,{global, Resource}).
+
+
View
28 org.erlide.kernel.ide/src/erlv8/erlv8_extern.erl
@@ -0,0 +1,28 @@
+-module(erlv8_extern).
+-export([get_proto/2, extern/2, type/1]).
+
+get_proto(VM, Proto) ->
+ erlv8_vm:enqueue_tick(VM, {extern_proto, Proto}).
+
+extern(VM, Value) ->
+ erlv8_vm:enqueue_tick(VM, {externalize, type(Value), Value}).
+
+type(Value) when is_number(Value) ->
+ num;
+type(Value) when is_atom(Value) ->
+ atom;
+type(Value) when is_binary(Value) ->
+ bin;
+type(Value) when is_reference(Value) ->
+ ref;
+type(Value) when is_function(Value) ->
+ 'fun';
+type(Value) when is_port(Value) ->
+ port;
+type(Value) when is_pid(Value) ->
+ pid;
+type(Value) when is_tuple(Value) ->
+ tuple;
+type(Value) when is_list(Value) ->
+ list.
+
View
24 org.erlide.kernel.ide/src/erlv8/erlv8_fun.erl
@@ -0,0 +1,24 @@
+-module(erlv8_fun,[Resource,VM]).
+-extends(erlv8_object).
+-export([call/0,call/1,call/2,instantiate/0, instantiate/1, object/0]).
+
+call() ->
+ call([]).
+
+call({erlv8_object, _,_}=T) ->
+ call(T,[]);
+
+call(Args) when is_list(Args) ->
+ erlv8_vm:enqueue_tick(VM, {call, Resource, Args}).
+
+call({erlv8_object, _,_}=This, Args) when is_list(Args) ->
+ erlv8_vm:enqueue_tick(VM, {call, Resource, Args, This}).
+
+instantiate() ->
+ instantiate([]).
+
+instantiate(Args) when is_list(Args) ->
+ erlv8_vm:enqueue_tick(VM, {inst, Resource, Args}).
+
+object() ->
+ {erlv8_object, Resource, VM}.
View
17 org.erlide.kernel.ide/src/erlv8/erlv8_fun_invocation.erl
@@ -0,0 +1,17 @@
+-module(erlv8_fun_invocation,[ICC,Holder,This,Ref,VM, Ctx]).
+-export([is_construct_call/0, holder/0, this/0, global/0, vm/0]).
+
+is_construct_call() ->
+ ICC.
+
+holder() ->
+ Holder.
+
+this() ->
+ This.
+
+global() ->
+ erlv8_context:global({VM,Ctx}).
+
+vm() ->
+ VM.
View
53 org.erlide.kernel.ide/src/erlv8/erlv8_nif.erl
@@ -0,0 +1,53 @@
+-module(erlv8_nif).
+-on_load(init/0).
+
+-export([init/0, new_vm/0, set_server/2, global/1, context/1, new_context/1,
+ tick/3, stop/2]).
+
+-define(DEFAULT_PREEMPTION, 100).
+
+init() ->
+ Preemption =
+ case application:get_env(erlv8, preemption_ms) of
+ {ok, V} ->
+ V;
+ _ ->
+ ?DEFAULT_PREEMPTION
+ end,
+ case os:getenv("ERLV8_SO_PATH") of
+ false ->
+ case code:which(erlv8_nif) of
+ Filename when is_list(Filename) ->
+%% io:format("erlv8_nif path:~p~n", [filename:dirname(Filename)]),
+%% erlang:load_nif(filename:join([filename:dirname(Filename),"../priv/erlv8_drv"]), Preemption);
+ erlang:load_nif("./erlv8_drv", Preemption);
+ Err ->
+ Err
+ end;
+ Path ->
+ Filename = filename:join([Path,"erlv8_drv"]),
+ erlang:load_nif(Filename,Preemption)
+ end.
+
+
+new_vm() ->
+ error(not_loaded).
+
+set_server(_VMObject,_Pid) ->
+ error(not_loaded).
+
+context(_VMObject) ->
+ error(not_loaded).
+
+new_context(_VMObject) ->
+ error(not_loaded).
+
+global(_ContextObject) ->
+ error(not_loaded).
+
+tick(_VMObject, _Ref, _Tick) ->
+ error(not_loaded).
+
+stop(_VMObject, _Ref) ->
+ error(not_loaded).
+
View
108 org.erlide.kernel.ide/src/erlv8/erlv8_object.erl
@@ -0,0 +1,108 @@
+-module(erlv8_object,[Resource,VM]).
+-export([proplist/0, set_value/2, set_value/3, set_hidden_value/2, get_value/1, get_value/2, get_hidden_value/1, get_hidden_value/2,
+ internal_field_count/0, get_internal_field/1, set_internal_field/2,
+ set_prototype/1, get_prototype/0, delete/1, set_accessor/2, set_accessor/3, set_accessor/4, set_accessor/5,
+ equals/1, strict_equals/1, call/1, call/2,new/1]).
+
+proplist() ->
+ erlv8_vm:enqueue_tick(VM,{proplist, Resource}).
+
+set_value(Key,Value) ->
+ erlv8_vm:enqueue_tick(VM, {set, Resource, Key, Value}).
+
+set_value(Key,Value,PropertyAttribute) ->
+ erlv8_vm:enqueue_tick(VM, {set, Resource, Key, Value, PropertyAttribute}).
+
+set_hidden_value(Key,Value) ->
+ erlv8_vm:enqueue_tick(VM, {set_hidden, Resource, Key, Value}).
+
+get_value(Key) ->
+ get_value(Key, undefined).
+
+get_value(Key, Default) ->
+ case erlv8_vm:enqueue_tick(VM, {get, Resource, Key}) of
+ undefined ->
+ Default;
+ Val ->
+ Val
+ end.
+
+get_hidden_value(Key) ->
+ get_hidden_value(Key, undefined).
+
+get_hidden_value(Key, Default) ->
+ case erlv8_vm:enqueue_tick(VM, {get_hidden, Resource, Key}) of
+ undefined ->
+ Default;
+ Val ->
+ Val
+ end.
+
+internal_field_count() ->
+ erlv8_vm:enqueue_tick(VM, {internal_count, Resource}).
+
+get_internal_field(Index) ->
+ erlv8_vm:enqueue_tick(VM, {get_internal, Resource, Index}).
+
+set_internal_field(Index, {extern, Value}) ->
+ erlv8_vm:enqueue_tick(VM, {set_internal_extern, Resource, Index, Value, erlv8_extern:type(Value)});
+
+set_internal_field(Index, Value) ->
+ erlv8_vm:enqueue_tick(VM, {set_internal, Resource, Index, Value}).
+
+set_prototype(Proto) ->
+ erlv8_vm:enqueue_tick(VM, {set_proto, Resource, Proto}).
+
+get_prototype() ->
+ erlv8_vm:enqueue_tick(VM, {get_proto, Resource}).
+
+delete(Key) ->
+ erlv8_vm:enqueue_tick(VM, {delete, Resource, Key}).
+
+set_accessor(Property, Getter) ->
+ case erlv8_vm:enqueue_tick(VM, {set_accessor, Resource, Property, Getter}) of
+ badarg ->
+ throw(badarg);
+ Result ->
+ Result
+ end.
+
+set_accessor(Property, Getter, Setter) ->
+ case erlv8_vm:enqueue_tick(VM, {set_accessor, Resource, Property, Getter, Setter}) of
+ badarg ->
+ throw(badarg);
+ Result ->
+ Result
+ end.
+
+set_accessor(Property, Getter, Setter, AccessControl) ->
+ case erlv8_vm:enqueue_tick(VM, {set_accessor, Resource, Property, Getter, Setter, AccessControl}) of
+ badarg ->
+ throw(badarg);
+ Result ->
+ Result
+ end.
+
+set_accessor(Property, Getter, Setter, AccessControl, PropertyAttribute) ->
+ case erlv8_vm:enqueue_tick(VM, {set_accessor, Resource, Property, Getter, Setter, AccessControl, PropertyAttribute}) of
+ badarg ->
+ throw(badarg);
+ Result ->
+ Result
+ end.
+
+equals({_Tag,AnotherObject,_}) ->
+ erlv8_value:equals(VM, Resource, AnotherObject).
+
+strict_equals({_Tag,AnotherObject,_}) ->
+ erlv8_value:strict_equals(VM, Resource, AnotherObject).
+
+call(Fun) ->
+ call(Fun,[]).
+
+call(Fun,Args) ->
+ Fun:call({erlv8_object, Resource,VM}, Args).
+
+new(O) ->
+ instance(O,undefined).
+
View
27 org.erlide.kernel.ide/src/erlv8/erlv8_sup.erl
@@ -0,0 +1,27 @@
+-module(erlv8_sup).
+
+-behaviour(supervisor2).
+
+%% API
+-export([start_link/0]).
+
+%% Supervisor callbacks
+-export([init/1]).
+
+%% Helper macro for declaring children of supervisor
+-define(CHILD(I, Restart, Type), {I, {I, start_link, []}, Restart, 5000, Type, [I]}).
+
+%% ===================================================================
+%% API functions
+%% ===================================================================
+
+start_link() ->
+ supervisor2:start_link({local, ?MODULE}, ?MODULE, []).
+
+%% ===================================================================
+%% Supervisor callbacks
+%% ===================================================================
+
+init([]) ->
+ {ok, { {simple_one_for_one_terminate, 5, 10}, [?CHILD(erlv8_vm,transient,worker)]} }.
+
View
8 org.erlide.kernel.ide/src/erlv8/erlv8_value.erl
@@ -0,0 +1,8 @@
+-module(erlv8_value).
+-export([equals/3,strict_equals/3]).
+
+equals(VM,V1,V2) ->
+ erlv8_vm:equals(VM, V1, V2).
+
+strict_equals(VM, V1,V2) ->
+ erlv8_vm:strict_equals(VM, V1, V2).
View
337 org.erlide.kernel.ide/src/erlv8/erlv8_vm.erl
@@ -0,0 +1,337 @@
+-module(erlv8_vm).
+
+-behaviour(gen_server2).
+-include_lib("../include/erlv8.hrl").
+
+%% API
+-export([start_link/1,start/0,vm_resource/1,run/2,run/3,run/4,global/1,stop/1,
+ to_string/2,to_detail_string/2,taint/2,untaint/1,equals/3, strict_equals/3,
+ enqueue_tick/2, enqueue_tick/3, enqueue_tick/4, next_tick/2, next_tick/3, next_tick/4,
+ stor/3, retr/2, gc/1]).
+
+%% gen_server2 callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3,prioritise_info/2]).
+
+-define(SERVER, ?MODULE).
+
+-record(state, {
+ vm,
+ ticked,
+ storage = [],
+ context,
+ debug
+ }).
+
+-define(Error(Msg), lists:flatten(io_lib:format("~s: ~p",[Msg,Trace]))).
+-define(ErrorVal(Msg), lists:flatten(io_lib:format("~s: ~p ~p",[Msg,Val,Trace]))).
+
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+start() ->
+ VM = erlv8_nif:new_vm(),
+ supervisor2:start_child(erlv8_sup,[VM]).
+
+vm_resource(Server) ->
+ gen_server2:call(Server, vm_resource).
+
+run(Server, Source) ->
+ run(Server, erlv8_context:get(Server), Source).
+
+run(Server, {_, _CtxRes} = Context, Source) ->
+ run(Server, Context, Source, {"unknown",0,0}).
+
+run(Server, {_, CtxRes}, Source, {Name, LineOffset, ColumnOffset}) ->
+ enqueue_tick(Server, {script, CtxRes, Source, Name, LineOffset, ColumnOffset}).
+
+global(Server) ->
+ Ctx = erlv8_context:get(Server),
+ erlv8_context:global(Ctx).
+
+stop(Server) ->
+ gen_server2:call(Server,stop).
+
+to_string(Server, Val) ->
+ enqueue_tick(Server, {to_string, Val}).
+
+to_detail_string(Server, Val) ->
+ enqueue_tick(Server, {to_detail_string, Val}).
+
+enqueue_tick(Server, Tick) ->
+ gen_server2:call(Server,{enqueue_tick, Tick}, infinity).
+
+enqueue_tick(Server, Tick, Ref) when is_reference(Ref) ->
+ gen_server2:call(Server,{enqueue_tick, Tick, Ref}, infinity);
+
+enqueue_tick(Server, Tick, Timeout) ->
+ gen_server2:call(Server,{enqueue_tick, Tick}, Timeout).
+
+enqueue_tick(Server, Tick, Timeout, Ref) when is_reference(Ref) ->
+ gen_server2:call(Server,{enqueue_tick, Tick, Ref}, Timeout).
+
+next_tick(Server, Tick) ->
+ gen_server2:call(Server,{next_tick, Tick}, infinity).
+
+next_tick(Server, Tick, Ref) when is_reference(Ref) ->
+ gen_server2:call(Server,{next_tick, Tick, Ref}, infinity);
+
+next_tick(Server, Tick, Timeout) ->
+ gen_server2:call(Server,{next_tick, Tick}, Timeout).
+
+next_tick(Server, Tick, Timeout, Ref) when is_reference(Ref) ->
+ gen_server2:call(Server,{next_tick, Tick, Ref}, Timeout).
+
+taint(Server, Value) ->
+ enqueue_tick(Server, {taint, Value}).
+
+equals(Server, V1, V2) ->
+ enqueue_tick(Server, {equals, V1, V2}).
+
+strict_equals(Server, V1, V2) ->
+ enqueue_tick(Server, {strict_equals, V1, V2}).
+
+
+stor(Server, Key, Value) ->
+ gen_server2:call(Server, {stor, Key, Value}).
+
+retr(Server, Key) ->
+ gen_server2:call(Server, {retr, Key}).
+
+
+untaint({erlv8_object, _,_}=O) ->
+ {erlv8_object,lists:map(fun ({Key, Val}) ->
+ {Key, untaint(Val)}
+ end,O:proplist()), undefined};
+untaint({erlv8_array, _,_}=O) ->
+ {erlv8_array,lists:map(fun untaint/1,O:list()), undefined};
+untaint({erlv8_fun, _,_}=F) -> %% broken
+ {erlv8_object,untaint(F:object()),undefined};
+untaint([H|T]) ->
+ [untaint(H)|untaint(T)];
+untaint([]) ->
+ [];
+untaint(Other) ->
+ Other.
+
+gc(Server) ->
+ (catch enqueue_tick(Server, {gc}, 0)),
+ ok.
+
+%%--------------------------------------------------------------------
+%% @doc
+%% Starts the server
+%%
+%% @spec start_link(VM) -> {ok, Pid} | ignore | {error, Error}
+%% @end
+%%--------------------------------------------------------------------
+start_link(VM) ->
+ gen_server2:start_link(?MODULE, [VM], []).
+
+%%%===================================================================
+%%% gen_server callbacks
+%%%===================================================================
+
+%%--------------------------------------------------------------------
+%% @private
+%% @doc
+%% Initializes the server
+%%
+%% @spec init(Args) -> {ok, State} |
+%% {ok, State, Timeout} |
+%% ignore |
+%% {stop, Reason}
+%% @end
+%%--------------------------------------------------------------------
+init([VM]) ->
+ process_flag(trap_exit, true),
+ erlv8_nif:set_server(VM, self()),
+ Ctx = erlv8_nif:context(VM),
+ {ok, #state{vm = VM, context = Ctx, debug = ets:new(erlv8_vm_debug,[]), ticked = ets:new(erlv8_vm_ticked,[public]) }}.
+
+%%--------------------------------------------------------------------
+%% @private
+%% @doc
+%% Handling call messages
+%%
+%% @spec handle_call(Request, From, State) ->
+%% {reply, Reply, State} |
+%% {reply, Reply, State, Timeout} |
+%% {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, Reply, State} |
+%% {stop, Reason, State}
+%% @end
+%%--------------------------------------------------------------------
+handle_call(vm_resource, _From, #state{ vm = VM } = State) ->
+ {reply, VM, State};
+
+handle_call({stor, Key, Value}, _From, #state{ storage = Storage } = State) ->
+ {reply, ok, State#state{ storage = [{Key, Value}|Storage] }};
+
+handle_call({retr, Key}, _From, #state{ storage = Storage } = State) ->
+ {reply, proplists:get_value(Key, Storage), State};
+
+handle_call(context, _From, #state{} = State) ->
+ {reply, {self(), State#state.context}, State};
+
+handle_call(new_context, _From, #state{ vm = VM } = State) ->
+ {reply, {self(), erlv8_nif:new_context(VM)}, State};
+
+handle_call({global, Resource}, _From, #state{} = State) ->
+ {reply, erlv8_nif:global(Resource), State};
+
+handle_call({to_string, Val}, _From, #state { vm = VM } = State) ->
+ Reply = erlv8_nif:to_string(VM, Val),
+ {reply, Reply, State};
+
+handle_call({to_detail_string, Val}, _From, #state { vm = VM } = State) ->
+ Reply = erlv8_nif:to_detail_string(VM, Val),
+ {reply, Reply, State};
+
+handle_call(stop, _From, State) ->
+ {stop, normal, ok, State};
+
+handle_call({enqueue_tick, Tick}, From, State) ->
+ Ref = make_ref(),
+ handle_call({enqueue_tick, Tick, Ref}, From, State);
+
+handle_call({enqueue_tick, Tick, Ref}, From, #state{ vm = VM, ticked = Ticked } = State) ->
+ tack = erlv8_nif:tick(VM, Ref, Tick),
+ update_ticked(Ref, From, Tick, Ticked),
+ {noreply, State};
+
+handle_call({next_tick, Tick}, From, State) ->
+ Ref = make_ref(),
+ handle_call({next_tick, Tick, Ref}, From, State);
+
+handle_call({next_tick, Tick, Ref}, From, #state{ vm = VM, ticked = Ticked } = State) ->
+ tack = erlv8_nif:tick(VM, Ref, Tick),
+ update_ticked(Ref, From, Tick, Ticked),
+ {noreply, State};
+
+handle_call(_Request, _From, State) ->
+ {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% @private
+%% @doc
+%% Handling cast messages
+%%
+%% @spec handle_cast(Msg, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State}
+%% @end
+%%--------------------------------------------------------------------
+handle_cast(run, #state{ vm = VM } = State) ->
+ erlv8_nif:run(VM, self()),
+ {noreply, State};
+
+handle_cast(_Msg, State) ->
+ {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% @private
+%% @doc
+%% Handling all non call/cast messages
+%%
+%% @spec handle_info(Info, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State}
+%% @end
+%%--------------------------------------------------------------------
+%% Invocation
+handle_info({F,#erlv8_fun_invocation{ is_construct_call = ICC, this = This, ref = Ref } = Invocation,Args}, #state{ ticked = Ticked } = State) when is_function(F), is_list(Args) ->
+ Self = self(),
+ spawn(fun () ->
+ Result = (catch erlang:apply(F,[Invocation,Args])),
+ Result1 =
+ case Result of
+ {'EXIT',{Val, Trace}} when is_atom(Val) ->
+ {throw, {error, ?Error(Val)}};
+ {'EXIT',{{Tag, Val}, Trace}} ->
+ {throw, {error, ?ErrorVal(Tag)}};
+ _ ->
+ case ICC of
+ true ->
+ This;
+ false ->
+ Result
+ end
+ end,
+ case ets:lookup(Ticked, Ref) of
+ [{Ref, {From, {call, _, _, _}}}] ->
+ gen_server2:reply(From, Result1),
+ ets:delete(Ticked, Ref);
+ [{Ref, {From, {call, _, _}}}] ->
+ gen_server2:reply(From, Result1),
+ ets:delete(Ticked, Ref);
+ [{Ref, {From, {inst, _, _}}}] ->
+ gen_server2:reply(From, Result1),
+ ets:delete(Ticked, Ref);
+ _ ->
+ enqueue_tick(Self, {result, Ref, Result1})
+ end
+ end),
+ {noreply, State};
+handle_info({result, Ref, Result}, #state{ ticked = Ticked } = State) ->
+ case ets:lookup(Ticked, Ref) of
+ [] ->
+ {noreply, State};
+ [{Ref, {From, _Tick}}] ->
+ gen_server2:reply(From, Result),
+ ets:delete(Ticked, Ref),
+ {noreply, State}
+ end;
+
+handle_info({'DEBUG',Name,Payload}, #state{ debug = Debug } = State) ->
+ ets:insert(Debug, {Name, Payload}),
+ {noreply, State};
+
+handle_info(_Info, State) ->
+ {noreply, State}.
+
+prioritise_info({retick, _}, _State) ->
+ 1;
+prioritise_info(tick_me,_State) ->
+ 0;
+prioritise_info(_,_State) ->
+ 0.
+
+
+%%--------------------------------------------------------------------
+%% @private
+%% @doc
+%% This function is called by a gen_server when it is about to
+%% terminate. It should be the opposite of Module:init/1 and do any
+%% necessary cleaning up. When it returns, the gen_server terminates
+%% with Reason. The return value is ignored.
+%%
+%% @spec terminate(Reason, State) -> void()
+%% @end
+%%--------------------------------------------------------------------
+terminate(_Reason, #state{ vm = VM } = _State) ->
+ ok = erlv8_nif:stop(VM,make_ref()).
+
+%%--------------------------------------------------------------------
+%% @private
+%% @doc
+%% Convert process state when code is changed
+%%
+%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState}
+%% @end
+%%--------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+update_ticked(_Ref, From, {result, _, _}, Ticked) -> %% do not insert results, nobody is going to reply on them
+ gen_server2:reply(From, ok),
+ Ticked;
+update_ticked(Ref, From, Tick, Ticked) ->
+ ets:insert(Ticked, {Ref, {From, Tick}}).
+
+
View
1,152 org.erlide.kernel.ide/src/erlv8/gen_server2.erl
@@ -0,0 +1,1152 @@
+%% This file is a copy of gen_server.erl from the R13B-1 Erlang/OTP
+%% distribution, with the following modifications:
+%%
+%% 1) the module name is gen_server2
+%%
+%% 2) more efficient handling of selective receives in callbacks
+%% gen_server2 processes drain their message queue into an internal
+%% buffer before invoking any callback module functions. Messages are
+%% dequeued from the buffer for processing. Thus the effective message
+%% queue of a gen_server2 process is the concatenation of the internal
+%% buffer and the real message queue.
+%% As a result of the draining, any selective receive invoked inside a
+%% callback is less likely to have to scan a large message queue.
+%%
+%% 3) gen_server2:cast is guaranteed to be order-preserving
+%% The original code could reorder messages when communicating with a
+%% process on a remote node that was not currently connected.
+%%
+%% 4) The callback module can optionally implement prioritise_call/3,
+%% prioritise_cast/2 and prioritise_info/2. These functions take
+%% Message, From and State or just Message and State and return a
+%% single integer representing the priority attached to the message.
+%% Messages with higher priorities are processed before requests with
+%% lower priorities. The default priority is 0.
+%%
+%% 5) The callback module can optionally implement
+%% handle_pre_hibernate/1 and handle_post_hibernate/1. These will be
+%% called immediately prior to and post hibernation, respectively. If
+%% handle_pre_hibernate returns {hibernate, NewState} then the process
+%% will hibernate. If the module does not implement
+%% handle_pre_hibernate/1 then the default action is to hibernate.
+%%
+%% 6) init can return a 4th arg, {backoff, InitialTimeout,
+%% MinimumTimeout, DesiredHibernatePeriod} (all in
+%% milliseconds). Then, on all callbacks which can return a timeout
+%% (including init), timeout can be 'hibernate'. When this is the
+%% case, the current timeout value will be used (initially, the
+%% InitialTimeout supplied from init). After this timeout has
+%% occurred, hibernation will occur as normal. Upon awaking, a new
+%% current timeout value will be calculated.
+%%
+%% The purpose is that the gen_server2 takes care of adjusting the
+%% current timeout value such that the process will increase the
+%% timeout value repeatedly if it is unable to sleep for the
+%% DesiredHibernatePeriod. If it is able to sleep for the
+%% DesiredHibernatePeriod it will decrease the current timeout down to
+%% the MinimumTimeout, so that the process is put to sleep sooner (and
+%% hopefully stays asleep for longer). In short, should a process
+%% using this receive a burst of messages, it should not hibernate
+%% between those messages, but as the messages become less frequent,
+%% the process will not only hibernate, it will do so sooner after
+%% each message.
+%%
+%% When using this backoff mechanism, normal timeout values (i.e. not
+%% 'hibernate') can still be used, and if they are used then the
+%% handle_info(timeout, State) will be called as normal. In this case,
+%% returning 'hibernate' from handle_info(timeout, State) will not
+%% hibernate the process immediately, as it would if backoff wasn't
+%% being used. Instead it'll wait for the current timeout as described
+%% above.
+
+%% All modifications are (C) 2009-2010 LShift Ltd.
+
+%% ``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 via the world wide web 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.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(gen_server2).
+
+%%% ---------------------------------------------------
+%%%
+%%% The idea behind THIS server is that the user module
+%%% provides (different) functions to handle different
+%%% kind of inputs.
+%%% If the Parent process terminates the Module:terminate/2
+%%% function is called.
+%%%
+%%% The user module should export:
+%%%
+%%% init(Args)
+%%% ==> {ok, State}
+%%% {ok, State, Timeout}
+%%% {ok, State, Timeout, Backoff}
+%%% ignore
+%%% {stop, Reason}
+%%%
+%%% handle_call(Msg, {From, Tag}, State)
+%%%
+%%% ==> {reply, Reply, State}
+%%% {reply, Reply, State, Timeout}
+%%% {noreply, State}
+%%% {noreply, State, Timeout}
+%%% {stop, Reason, Reply, State}
+%%% Reason = normal | shutdown | Term terminate(State) is called
+%%%
+%%% handle_cast(Msg, State)
+%%%
+%%% ==> {noreply, State}
+%%% {noreply, State, Timeout}
+%%% {stop, Reason, State}
+%%% Reason = normal | shutdown | Term terminate(State) is called
+%%%
+%%% handle_info(Info, State) Info is e.g. {'EXIT', P, R}, {nodedown, N}, ...
+%%%
+%%% ==> {noreply, State}
+%%% {noreply, State, Timeout}
+%%% {stop, Reason, State}
+%%% Reason = normal | shutdown | Term, terminate(State) is called
+%%%
+%%% terminate(Reason, State) Let the user module clean up
+%%% always called when server terminates
+%%%
+%%% ==> ok
+%%%
+%%% handle_pre_hibernate(State)
+%%%
+%%% ==> {hibernate, State}
+%%% {stop, Reason, State}
+%%% Reason = normal | shutdown | Term, terminate(State) is called
+%%%
+%%% handle_post_hibernate(State)
+%%%
+%%% ==> {noreply, State}
+%%% {stop, Reason, State}
+%%% Reason = normal | shutdown | Term, terminate(State) is called
+%%%
+%%% The work flow (of the server) can be described as follows:
+%%%
+%%% User module Generic
+%%% ----------- -------
+%%% start -----> start
+%%% init <----- .
+%%%
+%%% loop
+%%% handle_call <----- .
+%%% -----> reply
+%%%
+%%% handle_cast <----- .
+%%%
+%%% handle_info <----- .
+%%%
+%%% terminate <----- .
+%%%
+%%% -----> reply
+%%%
+%%%
+%%% ---------------------------------------------------
+
+%% API
+-export([start/3, start/4,
+ start_link/3, start_link/4,
+ call/2, call/3,
+ cast/2, reply/2,
+ abcast/2, abcast/3,
+ multi_call/2, multi_call/3, multi_call/4,
+ enter_loop/3, enter_loop/4, enter_loop/5, enter_loop/6, wake_hib/1]).
+
+-export([behaviour_info/1]).
+
+%% System exports
+-export([system_continue/3,
+ system_terminate/4,
+ system_code_change/4,
+ format_status/2]).
+
+%% Internal exports
+-export([init_it/6]).
+
+-import(error_logger, [format/2]).
+
+%% State record
+-record(gs2_state, {parent, name, state, mod, time,
+ timeout_state, queue, debug, prioritise_call,
+ prioritise_cast, prioritise_info}).
+
+%%%=========================================================================
+%%% Specs. These exist only to shut up dialyzer's warnings
+%%%=========================================================================
+
+-ifdef(use_specs).
+
+-type(gs2_state() :: #gs2_state{}).
+
+-spec(handle_common_termination/3 ::
+ (any(), atom(), gs2_state()) -> no_return()).
+-spec(hibernate/1 :: (gs2_state()) -> no_return()).
+-spec(pre_hibernate/1 :: (gs2_state()) -> no_return()).
+-spec(system_terminate/4 :: (_, _, _, gs2_state()) -> no_return()).
+
+-endif.
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+behaviour_info(callbacks) ->
+ [{init,1},{handle_call,3},{handle_cast,2},{handle_info,2},
+ {terminate,2},{code_change,3}];
+behaviour_info(_Other) ->
+ undefined.
+
+%%% -----------------------------------------------------------------
+%%% Starts a generic server.
+%%% start(Mod, Args, Options)
+%%% start(Name, Mod, Args, Options)
+%%% start_link(Mod, Args, Options)
+%%% start_link(Name, Mod, Args, Options) where:
+%%% Name ::= {local, atom()} | {global, atom()}
+%%% Mod ::= atom(), callback module implementing the 'real' server
+%%% Args ::= term(), init arguments (to Mod:init/1)
+%%% Options ::= [{timeout, Timeout} | {debug, [Flag]}]
+%%% Flag ::= trace | log | {logfile, File} | statistics | debug
+%%% (debug == log && statistics)
+%%% Returns: {ok, Pid} |
+%%% {error, {already_started, Pid}} |
+%%% {error, Reason}
+%%% -----------------------------------------------------------------
+start(Mod, Args, Options) ->
+ gen:start(?MODULE, nolink, Mod, Args, Options).
+
+start(Name, Mod, Args, Options) ->
+ gen:start(?MODULE, nolink, Name, Mod, Args, Options).
+
+start_link(Mod, Args, Options) ->
+ gen:start(?MODULE, link, Mod, Args, Options).
+
+start_link(Name, Mod, Args, Options) ->
+ gen:start(?MODULE, link, Name, Mod, Args, Options).
+
+
+%% -----------------------------------------------------------------
+%% Make a call to a generic server.
+%% If the server is located at another node, that node will
+%% be monitored.
+%% If the client is trapping exits and is linked server termination
+%% is handled here (? Shall we do that here (or rely on timeouts) ?).
+%% -----------------------------------------------------------------
+call(Name, Request) ->
+ case catch gen:call(Name, '$gen_call', Request) of
+ {ok,Res} ->
+ Res;
+ {'EXIT',Reason} ->
+ exit({Reason, {?MODULE, call, [Name, Request]}})
+ end.
+
+call(Name, Request, Timeout) ->
+ case catch gen:call(Name, '$gen_call', Request, Timeout) of
+ {ok,Res} ->
+ Res;
+ {'EXIT',Reason} ->
+ exit({Reason, {?MODULE, call, [Name, Request, Timeout]}})
+ end.
+
+%% -----------------------------------------------------------------
+%% Make a cast to a generic server.
+%% -----------------------------------------------------------------
+cast({global,Name}, Request) ->
+ catch global:send(Name, cast_msg(Request)),
+ ok;
+cast({Name,Node}=Dest, Request) when is_atom(Name), is_atom(Node) ->
+ do_cast(Dest, Request);
+cast(Dest, Request) when is_atom(Dest) ->
+ do_cast(Dest, Request);
+cast(Dest, Request) when is_pid(Dest) ->
+ do_cast(Dest, Request).
+
+do_cast(Dest, Request) ->
+ do_send(Dest, cast_msg(Request)),
+ ok.
+
+cast_msg(Request) -> {'$gen_cast',Request}.
+
+%% -----------------------------------------------------------------
+%% Send a reply to the client.
+%% -----------------------------------------------------------------
+reply({To, Tag}, Reply) ->
+ catch To ! {Tag, Reply}.
+
+%% -----------------------------------------------------------------
+%% Asyncronous broadcast, returns nothing, it's just send'n pray
+%% -----------------------------------------------------------------
+abcast(Name, Request) when is_atom(Name) ->
+ do_abcast([node() | nodes()], Name, cast_msg(Request)).
+
+abcast(Nodes, Name, Request) when is_list(Nodes), is_atom(Name) ->
+ do_abcast(Nodes, Name, cast_msg(Request)).
+
+do_abcast([Node|Nodes], Name, Msg) when is_atom(Node) ->
+ do_send({Name,Node},Msg),
+ do_abcast(Nodes, Name, Msg);
+do_abcast([], _,_) -> abcast.
+
+%%% -----------------------------------------------------------------
+%%% Make a call to servers at several nodes.
+%%% Returns: {[Replies],[BadNodes]}
+%%% A Timeout can be given
+%%%
+%%% A middleman process is used in case late answers arrives after
+%%% the timeout. If they would be allowed to glog the callers message
+%%% queue, it would probably become confused. Late answers will
+%%% now arrive to the terminated middleman and so be discarded.
+%%% -----------------------------------------------------------------
+multi_call(Name, Req)
+ when is_atom(Name) ->
+ do_multi_call([node() | nodes()], Name, Req, infinity).
+
+multi_call(Nodes, Name, Req)
+ when is_list(Nodes), is_atom(Name) ->
+ do_multi_call(Nodes, Name, Req, infinity).
+
+multi_call(Nodes, Name, Req, infinity) ->
+ do_multi_call(Nodes, Name, Req, infinity);
+multi_call(Nodes, Name, Req, Timeout)
+ when is_list(Nodes), is_atom(Name), is_integer(Timeout), Timeout >= 0 ->
+ do_multi_call(Nodes, Name, Req, Timeout).
+
+
+%%-----------------------------------------------------------------
+%% enter_loop(Mod, Options, State, <ServerName>, <TimeOut>, <Backoff>) ->_
+%%
+%% Description: Makes an existing process into a gen_server.
+%% The calling process will enter the gen_server receive
+%% loop and become a gen_server process.
+%% The process *must* have been started using one of the
+%% start functions in proc_lib, see proc_lib(3).
+%% The user is responsible for any initialization of the
+%% process, including registering a name for it.
+%%-----------------------------------------------------------------
+enter_loop(Mod, Options, State) ->
+ enter_loop(Mod, Options, State, self(), infinity, undefined).
+
+enter_loop(Mod, Options, State, Backoff = {backoff, _, _ , _}) ->
+ enter_loop(Mod, Options, State, self(), infinity, Backoff);
+
+enter_loop(Mod, Options, State, ServerName = {_, _}) ->
+ enter_loop(Mod, Options, State, ServerName, infinity, undefined);
+
+enter_loop(Mod, Options, State, Timeout) ->
+ enter_loop(Mod, Options, State, self(), Timeout, undefined).
+
+enter_loop(Mod, Options, State, ServerName, Backoff = {backoff, _, _, _}) ->
+ enter_loop(Mod, Options, State, ServerName, infinity, Backoff);
+
+enter_loop(Mod, Options, State, ServerName, Timeout) ->
+ enter_loop(Mod, Options, State, ServerName, Timeout, undefined).
+
+enter_loop(Mod, Options, State, ServerName, Timeout, Backoff) ->
+ Name = get_proc_name(ServerName),
+ Parent = get_parent(),
+ Debug = debug_options(Name, Options),
+ Queue = priority_queue:new(),
+ Backoff1 = extend_backoff(Backoff),
+ loop(find_prioritisers(
+ #gs2_state { parent = Parent, name = Name, state = State,
+ mod = Mod, time = Timeout, timeout_state = Backoff1,
+ queue = Queue, debug = Debug })).
+
+%%%========================================================================
+%%% Gen-callback functions
+%%%========================================================================
+
+%%% ---------------------------------------------------
+%%% Initiate the new process.
+%%% Register the name using the Rfunc function
+%%% Calls the Mod:init/Args function.
+%%% Finally an acknowledge is sent to Parent and the main
+%%% loop is entered.
+%%% ---------------------------------------------------
+init_it(Starter, self, Name, Mod, Args, Options) ->
+ init_it(Starter, self(), Name, Mod, Args, Options);
+init_it(Starter, Parent, Name0, Mod, Args, Options) ->
+ Name = name(Name0),
+ Debug = debug_options(Name, Options),
+ Queue = priority_queue:new(),
+ GS2State = find_prioritisers(
+ #gs2_state { parent = Parent,
+ name = Name,
+ mod = Mod,
+ queue = Queue,
+ debug = Debug }),
+ case catch Mod:init(Args) of
+ {ok, State} ->
+ proc_lib:init_ack(Starter, {ok, self()}),
+ loop(GS2State #gs2_state { state = State,
+ time = infinity,
+ timeout_state = undefined });
+ {ok, State, Timeout} ->
+ proc_lib:init_ack(Starter, {ok, self()}),
+ loop(GS2State #gs2_state { state = State,
+ time = Timeout,
+ timeout_state = undefined });
+ {ok, State, Timeout, Backoff = {backoff, _, _, _}} ->
+ Backoff1 = extend_backoff(Backoff),
+ proc_lib:init_ack(Starter, {ok, self()}),
+ loop(GS2State #gs2_state { state = State,
+ time = Timeout,
+ timeout_state = Backoff1 });
+ {stop, Reason} ->
+ %% For consistency, we must make sure that the
+ %% registered name (if any) is unregistered before
+ %% the parent process is notified about the failure.
+ %% (Otherwise, the parent process could get
+ %% an 'already_started' error if it immediately
+ %% tried starting the process again.)
+ unregister_name(Name0),
+ proc_lib:init_ack(Starter, {error, Reason}),
+ exit(Reason);
+ ignore ->
+ unregister_name(Name0),
+ proc_lib:init_ack(Starter, ignore),
+ exit(normal);
+ {'EXIT', Reason} ->
+ unregister_name(Name0),
+ proc_lib:init_ack(Starter, {error, Reason}),
+ exit(Reason);
+ Else ->
+ Error = {bad_return_value, Else},
+ proc_lib:init_ack(Starter, {error, Error}),
+ exit(Error)
+ end.
+
+name({local,Name}) -> Name;
+name({global,Name}) -> Name;
+%% name(Pid) when is_pid(Pid) -> Pid;
+%% when R12 goes away, drop the line beneath and uncomment the line above
+name(Name) -> Name.
+
+unregister_name({local,Name}) ->
+ _ = (catch unregister(Name));
+unregister_name({global,Name}) ->
+ _ = global:unregister_name(Name);
+unregister_name(Pid) when is_pid(Pid) ->
+ Pid;
+% Under R12 let's just ignore it, as we have a single term as Name.
+% On R13 it will never get here, as we get tuple with 'local/global' atom.
+unregister_name(_Name) -> ok.
+
+extend_backoff(undefined) ->
+ undefined;
+extend_backoff({backoff, InitialTimeout, MinimumTimeout, DesiredHibPeriod}) ->
+ {backoff, InitialTimeout, MinimumTimeout, DesiredHibPeriod, now()}.
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+%%% ---------------------------------------------------
+%%% The MAIN loop.
+%%% ---------------------------------------------------
+loop(GS2State = #gs2_state { time = hibernate,
+ timeout_state = undefined }) ->
+ pre_hibernate(GS2State);
+loop(GS2State) ->
+ process_next_msg(drain(GS2State)).
+
+drain(GS2State) ->
+ receive
+ Input -> drain(in(Input, GS2State))
+ after 0 -> GS2State
+ end.
+
+process_next_msg(GS2State = #gs2_state { time = Time,
+ timeout_state = TimeoutState,
+ queue = Queue }) ->
+ case priority_queue:out(Queue) of
+ {{value, Msg}, Queue1} ->
+ process_msg(Msg, GS2State #gs2_state { queue = Queue1 });
+ {empty, Queue1} ->
+ {Time1, HibOnTimeout}
+ = case {Time, TimeoutState} of
+ {hibernate, {backoff, Current, _Min, _Desired, _RSt}} ->
+ {Current, true};
+ {hibernate, _} ->
+ %% wake_hib/7 will set Time to hibernate. If
+ %% we were woken and didn't receive a msg
+ %% then we will get here and need a sensible
+ %% value for Time1, otherwise we crash.
+ %% R13B1 always waits infinitely when waking
+ %% from hibernation, so that's what we do
+ %% here too.
+ {infinity, false};
+ _ -> {Time, false}
+ end,
+ receive
+ Input ->
+ %% Time could be 'hibernate' here, so *don't* call loop
+ process_next_msg(
+ drain(in(Input, GS2State #gs2_state { queue = Queue1 })))
+ after Time1 ->
+ case HibOnTimeout of
+ true ->
+ pre_hibernate(
+ GS2State #gs2_state { queue = Queue1 });
+ false ->
+ process_msg(timeout,
+ GS2State #gs2_state { queue = Queue1 })
+ end
+ end
+ end.
+
+wake_hib(GS2State = #gs2_state { timeout_state = TS }) ->
+ TimeoutState1 = case TS of
+ undefined ->
+ undefined;
+ {SleptAt, TimeoutState} ->
+ adjust_timeout_state(SleptAt, now(), TimeoutState)
+ end,
+ post_hibernate(
+ drain(GS2State #gs2_state { timeout_state = TimeoutState1 })).
+
+hibernate(GS2State = #gs2_state { timeout_state = TimeoutState }) ->
+ TS = case TimeoutState of
+ undefined -> undefined;
+ {backoff, _, _, _, _} -> {now(), TimeoutState}
+ end,
+ proc_lib:hibernate(?MODULE, wake_hib,
+ [GS2State #gs2_state { timeout_state = TS }]).
+
+pre_hibernate(GS2State = #gs2_state { state = State,
+ mod = Mod }) ->
+ case erlang:function_exported(Mod, handle_pre_hibernate, 1) of
+ true ->
+ case catch Mod:handle_pre_hibernate(State) of
+ {hibernate, NState} ->
+ hibernate(GS2State #gs2_state { state = NState } );
+ Reply ->
+ handle_common_termination(Reply, pre_hibernate, GS2State)
+ end;
+ false ->
+ hibernate(GS2State)
+ end.
+
+post_hibernate(GS2State = #gs2_state { state = State,
+ mod = Mod }) ->
+ case erlang:function_exported(Mod, handle_post_hibernate, 1) of
+ true ->
+ case catch Mod:handle_post_hibernate(State) of
+ {noreply, NState} ->
+ process_next_msg(GS2State #gs2_state { state = NState,
+ time = infinity });
+ {noreply, NState, Time} ->
+ process_next_msg(GS2State #gs2_state { state = NState,
+ time = Time });
+ Reply ->
+ handle_common_termination(Reply, post_hibernate, GS2State)
+ end;
+ false ->
+ %% use hibernate here, not infinity. This matches
+ %% R13B. The key is that we should be able to get through
+ %% to process_msg calling sys:handle_system_msg with Time
+ %% still set to hibernate, iff that msg is the very msg
+ %% that woke us up (or the first msg we receive after
+ %% waking up).
+ process_next_msg(GS2State #gs2_state { time = hibernate })
+ end.
+
+adjust_timeout_state(SleptAt, AwokeAt, {backoff, CurrentTO, MinimumTO,
+ DesiredHibPeriod, RandomState}) ->
+ NapLengthMicros = timer:now_diff(AwokeAt, SleptAt),
+ CurrentMicros = CurrentTO * 1000,
+ MinimumMicros = MinimumTO * 1000,
+ DesiredHibMicros = DesiredHibPeriod * 1000,
+ GapBetweenMessagesMicros = NapLengthMicros + CurrentMicros,
+ Base =
+ %% If enough time has passed between the last two messages then we
+ %% should consider sleeping sooner. Otherwise stay awake longer.
+ case GapBetweenMessagesMicros > (MinimumMicros + DesiredHibMicros) of
+ true -> lists:max([MinimumTO, CurrentTO div 2]);
+ false -> CurrentTO
+ end,
+ {Extra, RandomState1} = random:uniform_s(Base, RandomState),
+ CurrentTO1 = Base + Extra,
+ {backoff, CurrentTO1, MinimumTO, DesiredHibPeriod, RandomState1}.
+
+in({'$gen_cast', Msg}, GS2State = #gs2_state { prioritise_cast = PC,
+ queue = Queue }) ->
+ GS2State #gs2_state { queue = priority_queue:in(
+ {'$gen_cast', Msg},
+ PC(Msg, GS2State), Queue) };
+in({'$gen_call', From, Msg}, GS2State = #gs2_state { prioritise_call = PC,
+ queue = Queue }) ->
+ GS2State #gs2_state { queue = priority_queue:in(
+ {'$gen_call', From, Msg},
+ PC(Msg, From, GS2State), Queue) };
+in(Input, GS2State = #gs2_state { prioritise_info = PI, queue = Queue }) ->
+ GS2State #gs2_state { queue = priority_queue:in(
+ Input, PI(Input, GS2State), Queue) }.
+
+process_msg(Msg,
+ GS2State = #gs2_state { parent = Parent,
+ name = Name,
+ debug = Debug }) ->
+ case Msg of