1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21-module(multi_load_SUITE).
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,
24	 basic_atomic_load/1,basic_errors/1,sticky_dir/1,
25	 on_load_failing/1,ensure_modules_loaded/1]).
26
27-include_lib("common_test/include/ct.hrl").
28-include_lib("syntax_tools/include/merl.hrl").
29
30suite() ->
31    [{ct_hooks,[ts_install_cth]},
32     {timetrap,{minutes,1}}].
33
34all() ->
35    [basic_atomic_load,basic_errors,sticky_dir,on_load_failing,
36     ensure_modules_loaded].
37
38groups() ->
39    [].
40
41init_per_suite(Config) ->
42    Config.
43
44end_per_suite(_Config) ->
45    ok.
46
47init_per_group(_GroupName, Config) ->
48    Config.
49
50end_per_group(_GroupName, Config) ->
51    Config.
52
53basic_atomic_load(Config) ->
54    PrivDir = proplists:get_value(priv_dir, Config),
55    Dir = filename:join(PrivDir, multi_load_sticky_dir),
56    _ = file:make_dir(Dir),
57
58    OldPath = code:get_path(),
59    try
60	code:add_patha(Dir),
61	do_basic(Dir)
62    after
63	code:set_path(OldPath)
64    end,
65
66    ok.
67
68do_basic(Dir) ->
69    MsVer1_0 = make_modules(5, versioned_module(1)),
70    MsVer1 = [{M,filename:absname(F, Dir),Bin} || {M,F,Bin} <- MsVer1_0],
71    _ = [ok = file:write_file(F, Bin) || {_,F,Bin} <- MsVer1],
72
73    Ms = [M || {M,_,_} <- MsVer1],
74    [] = [loaded || M <- Ms, is_loaded(M)],
75
76    ok = code:atomic_load(Ms),
77    _ = [1 = M:M() || M <- Ms],
78    _ = [F = code:which(M) || {M,F,_} <- MsVer1],
79    [] = [not_loaded || M <- Ms, not is_loaded(M)],
80
81    MsVer2 = update_modules(Ms, versioned_module(2)),
82    {ok,Prepared} = code:prepare_loading(MsVer2),
83    ok = code:finish_loading(Prepared),
84    _ = [2 = M:M() || M <- Ms],
85    _ = [F = code:which(M) || {M,F,_} <- MsVer2],
86    [] = [not_loaded || M <- Ms, not is_loaded(M)],
87
88    MsVer3 = update_modules(Ms, versioned_module(2)),
89    NotPurged = lists:sort([{M,not_purged} || M <- Ms]),
90    NotPurged = atomic_load_error(MsVer3, true),
91
92    ok.
93
94versioned_module(Ver) ->
95    fun(Mod) ->
96	    ?Q(["-module('@Mod@').\n",
97		"-export(['@Mod@'/0]).\n",
98		"'@Mod@'() -> _@Ver@.\n"])
99    end.
100
101basic_errors(_Config) ->
102    atomic_load_fc([42]),
103    atomic_load_fc([{"mod","file","bin"}]),
104
105    finish_loading_fc(atom),
106    {ok,{PrepTag,_}} = code:prepare_loading([code]),
107    finish_loading_fc({PrepTag,[x]}),
108    finish_loading_fc({PrepTag,[{m,{<<>>,"",<<>>}}]}),
109    Prep = prepared_with_wrong_magic_bin(),
110    finish_loading_fc(Prep),
111
112    [{x,badfile}] = atomic_load_error([{x,"x",<<"bad">>}], false),
113    [{a,badfile},{some_nonexistent_file,nofile}] =
114	atomic_load_error([some_nonexistent_file,{a,"a",<<>>}],
115			  false),
116
117    %% Modules mentioned more than once.
118    Mods = make_modules(2, fun basic_module/1),
119    Ms = [M || {M,_,_} <- Mods],
120    DupMods = Mods ++ [mnesia] ++ Mods ++ [mnesia],
121    DupErrors0 = lists:sort([mnesia|Ms]),
122    DupErrors = [{M,duplicated} || M <- DupErrors0],
123    DupErrors = atomic_load_error(DupMods, false),
124
125    ok.
126
127atomic_load_fc(L) ->
128    {'EXIT',{function_clause,[{code,atomic_load,[L],_}|_]}} =
129	(catch code:atomic_load(L)),
130    {'EXIT',{function_clause,[{code,prepare_loading,[L],_}|_]}} =
131	(catch code:prepare_loading(L)).
132
133finish_loading_fc(Term) ->
134    {'EXIT',{function_clause,[{code,finish_loading,[Term],_}|_]}} =
135	(catch code:finish_loading(Term)).
136
137prepared_with_wrong_magic_bin() ->
138    {ok,Prep} = code:prepare_loading([?MODULE]),
139    prep_magic(Prep).
140
141prep_magic([H|T]) ->
142    [prep_magic(H)|prep_magic(T)];
143prep_magic(Tuple) when is_tuple(Tuple) ->
144    L = prep_magic(tuple_to_list(Tuple)),
145    list_to_tuple(L);
146prep_magic(Ref) when is_reference(Ref) ->
147    try erlang:has_prepared_code_on_load(Ref) of
148	false ->
149	    %% Create a different kind of magic ref.
150	    ets:match_spec_compile([{'_',[true],['$_']}])
151    catch
152	_:_ ->
153	    Ref
154    end;
155prep_magic(Other) ->
156    Other.
157
158sticky_dir(_Config) ->
159    Mod0 = make_module(lists, fun basic_module/1),
160    Mod1 = make_module(gen_server, fun basic_module/1),
161    Ms = [Mod0,Mod1],
162    SD = sticky_directory,
163    StickyErrors = [{gen_server,SD},{lists,SD}],
164    StickyErrors = atomic_load_error(Ms, true),
165
166    ok.
167
168on_load_failing(_Config) ->
169    OnLoad = make_modules(1, fun on_load_module/1),
170    [{OnLoadMod,_,_}] = OnLoad,
171    Ms = make_modules(10, fun basic_module/1) ++ OnLoad,
172
173    %% Fail because there is a module with on_load in the list.
174    on_load_failure(OnLoadMod, Ms),
175    on_load_failure(OnLoadMod, [lists:last(Ms)]),
176
177    %% Fail because there already is a pending on_load.
178    [{HangingOnLoad,_,_}|_] = Ms,
179    spawn_hanging_on_load(HangingOnLoad),
180    NoOnLoadMs = lists:droplast(Ms),
181    {error,[{HangingOnLoad,pending_on_load}]} =
182	code:atomic_load(NoOnLoadMs),
183    hanging_on_load ! stop_hanging_and_unload,
184
185    ok.
186
187on_load_failure(OnLoadMod, Ms) ->
188    [{OnLoadMod,on_load_not_allowed}] = atomic_load_error(Ms, false).
189
190spawn_hanging_on_load(Mod) ->
191    {Mod,Name,Bin} = make_module(Mod, "unknown",
192				 fun(_) ->
193					 hanging_on_load_module(Mod)
194				 end),
195    spawn_link(fun() ->
196		       {error,on_load_failure} =
197			   code:load_binary(Mod, Name, Bin)
198	       end).
199
200hanging_on_load_module(Mod) ->
201    ?Q(["-module('@Mod@').\n",
202	"-on_load(hang/0).\n",
203	"hang() ->\n"
204	"  register(hanging_on_load, self()),\n"
205	"  receive _ -> unload end.\n"]).
206
207ensure_modules_loaded(Config) ->
208    PrivDir = proplists:get_value(priv_dir, Config),
209    Dir = filename:join(PrivDir, multi_load_ensure_modules_loaded),
210    _ = file:make_dir(Dir),
211
212    OldPath = code:get_path(),
213    try
214	code:add_patha(Dir),
215	do_ensure_modules_loaded(Dir)
216    after
217	code:set_path(OldPath)
218    end,
219
220    ok.
221
222do_ensure_modules_loaded(Dir) ->
223    %% Create a dummy "lists" module and place it in our code path.
224    {lists,ListsFile,ListsCode} = make_module(lists, fun basic_module/1),
225    ok = file:write_file(filename:absname(ListsFile, Dir), ListsCode),
226    {error,sticky_directory} = code:load_file(lists),
227
228    %% Make a new module that we can load.
229    Mod = make_module_file(Dir, fun basic_module/1),
230    false = is_loaded(Mod),
231
232    %% Make a new module with an on_load function.
233    OLMod = make_module_file(Dir, fun on_load_module/1),
234    false = is_loaded(OLMod),
235
236    %% lists should not be loaded again; Mod and OLMod should be
237    %% loaded.  ?MODULE should not be reloaded, but there is no easy
238    %% way to test that.  Repeating modules is OK.
239    ok = code:ensure_modules_loaded([?MODULE,lists,Mod,OLMod,
240				     Mod,OLMod,Mod,lists]),
241    last = lists:last([last]),
242    true = is_loaded(Mod),
243    ok = Mod:Mod(),
244    true = is_loaded(OLMod),
245    _ = OLMod:module_info(),
246
247    %% Unload the modules that were loaded.
248    [begin
249	 code:purge(M),
250	 code:delete(M),
251	 code:purge(M),
252	 false = is_loaded(M)
253     end || M <- [Mod,OLMod]],
254
255    %% If there are some errors, all other modules should be loaded
256    %% anyway.
257    [{BadMod,BadFile,_}] = make_modules(1, fun basic_module/1),
258    ok = file:write_file(filename:absname(BadFile, Dir), <<"bad_code">>),
259    BadOLMod = make_module_file(Dir, fun failing_on_load_module/1),
260    BadEgg = bad__egg,
261    ModulesToLoad = [OLMod,?MODULE,Mod,BadOLMod,BadEgg,BadMod,lists],
262    {error,Error0} = code:ensure_modules_loaded(ModulesToLoad),
263    Error = lists:sort([{BadEgg,nofile},
264			{BadMod,badfile},
265			{BadOLMod,on_load_failure}]),
266    Error = lists:sort(Error0),
267    true = is_loaded(Mod),
268    true = is_loaded(OLMod),
269
270    ok.
271
272failing_on_load_module(Mod) ->
273    ?Q(["-module('@Mod@').\n",
274	"-on_load(f/0).\n",
275	"f() -> fail.\n"]).
276
277%%%
278%%% Common utilities
279%%%
280
281atomic_load_error(Modules, ErrorInFinishLoading) ->
282    {error,Errors0} = code:atomic_load(Modules),
283    {Errors1,Bool} =
284	case code:prepare_loading(Modules) of
285	    {ok,Prepared} ->
286		{error,Es0} = code:finish_loading(Prepared),
287		{Es0,true};
288	     {error,Es0} ->
289		{Es0,false}
290	end,
291    Errors = lists:sort(Errors0),
292    Errors = lists:sort(Errors1),
293    case {ErrorInFinishLoading,Bool} of
294	{B,B} ->
295	    Errors;
296	{false,true} ->
297	    ct:fail("code:prepare_loading/1 should have failed");
298	{true,false} ->
299	    ct:fail("code:prepare_loading/1 should have succeeded")
300    end.
301
302is_loaded(Mod) ->
303    case erlang:module_loaded(Mod) of
304	false ->
305	    false = code:is_loaded(Mod);
306	true ->
307	    {file,_} = code:is_loaded(Mod),
308	    true
309    end.
310
311basic_module(Mod) ->
312    ?Q(["-module('@Mod@').\n"
313	"-export(['@Mod@'/0]).\n",
314	"'@Mod@'() -> ok."]).
315
316on_load_module(Mod) ->
317    ?Q(["-module('@Mod@').\n",
318	"-on_load(f/0).\n",
319	"f() -> ok.\n"]).
320
321make_module_file(Dir, Fun) ->
322    [{Mod,File,Code}] = make_modules(1, Fun),
323    ok = file:write_file(filename:absname(File, Dir), Code),
324    Mod.
325
326make_modules(0, _) ->
327    [];
328make_modules(N, Fun) ->
329    U = erlang:unique_integer([positive]),
330    ModName = "m__" ++ integer_to_list(N) ++ "_" ++ integer_to_list(U),
331    Mod = list_to_atom(ModName),
332    ModItem = make_module(Mod, Fun),
333    [ModItem|make_modules(N-1, Fun)].
334
335update_modules(Ms, Fun) ->
336    [make_module(M, Fun) || M <- Ms].
337
338make_module(Mod, Fun) ->
339    Filename = atom_to_list(Mod) ++ ".beam",
340    make_module(Mod, Filename, Fun).
341
342make_module(Mod, Filename, Fun) ->
343    make_module(Mod, Filename, Fun, []).
344
345make_module(Mod, Filename, Fun, Opts) ->
346    Tree = Fun(Mod),
347    merl:print(Tree),
348    {ok,Mod,Code} = merl:compile(Tree, Opts),
349    {Mod,Filename,Code}.
350