Added support for top-level info and diagnostic messages.
[erlang-estap.git] / src / estap_file.erl
1 %%%---------------------------------------------------------------------------
2 %%% @doc
3 %%%   Functions to work with files.
4 %%% @end
5 %%%---------------------------------------------------------------------------
6
7 -module(estap_file).
8
9 %% public interface
10 -export([tempdir/0, tempdir/1]).
11 -export([read_file/2, read_file/3]).
12
13 -export([load_code/1]).
14
15 %%%---------------------------------------------------------------------------
16 %%% types and definitions {{{
17
18 -define(STEM_PREFIX, "estap").
19 -define(STEM_LEN, 8).
20 -define(DEFAULT_TMP, "/tmp").
21
22 -record(test, {
23   %% TODO: `-prep(fun/0)', `-cleanup(fun/1)'
24   name :: atom(),
25   desc :: string(),
26   todo = false :: {true, Reason :: string()} | false,
27   skip = false :: {true, Reason :: string()} | false
28 }).
29
30 %%% }}}
31 %%%---------------------------------------------------------------------------
32 %%% public interface
33 %%%---------------------------------------------------------------------------
34
35 %%----------------------------------------------------------
36 %% temporary directories {{{
37
38 %% @doc Create a temporary directory of unique name.
39 %%   The directory is created under `$TMP', or `/tmp' if the variable is not
40 %%   set.
41
42 -spec tempdir() ->
43   {ok, file:filename()} | {error, term()}.
44
45 tempdir() ->
46   case os:getenv("TMP") of
47     Dir when is_list(Dir) ->
48       tempdir(Dir);
49     false ->
50       tempdir(?DEFAULT_TMP)
51   end.
52
53 %% @doc Create a temporary directory of unique name under specified directory.
54
55 -spec tempdir(file:name()) ->
56   {ok, file:filename()} | {error, term()}.
57
58 tempdir(TempDir) ->
59   StemSeed = crypto:sha(term_to_binary(make_ref())),
60   <<Stem:?STEM_LEN/binary, _/binary>> = base64:encode(StemSeed),
61   DirName = filename:join(TempDir, ?STEM_PREFIX ++ "." ++ binary_to_list(Stem)),
62   case file:make_dir(DirName) of
63     ok ->
64       {ok, DirName};
65     {error, eexist} ->
66       % try again, maybe next one will succeed
67       tempdir(TempDir);
68     {error, Reason} ->
69       {error, Reason}
70   end.
71
72 %% }}}
73 %%----------------------------------------------------------
74 %% parsing test files {{{
75
76 %% @doc Load estap file as ABF forms.
77
78 -spec read_file(file:name(), [file:name()]) ->
79   {ok, {module(), [erl_parse:abstract_form()]}} | {error, term()}.
80
81 read_file(File, IncludePath) ->
82   read_file(File, IncludePath, ?DEFAULT_TMP).
83
84 %% @doc Load estap file as ABF forms.
85
86 -spec read_file(file:name(), [file:name()], file:name()) ->
87   {ok, {module(), [erl_parse:abstract_form()]}} | {error, term()}.
88
89 read_file(File, IncludePath, TempDir) ->
90   case tempdir(TempDir) of
91     {ok, DirName} ->
92       case copy_source(File, DirName) of
93         {ok, ModuleFile} ->
94           Result = parse_file(ModuleFile, File, IncludePath),
95           ok = file:delete(ModuleFile),
96           ok = file:del_dir(DirName),
97           Result;
98         {error, Reason} ->
99           ok = file:del_dir(TempDir),
100           {error, Reason}
101       end;
102     {error, Reason} ->
103       {error, Reason}
104   end.
105
106 %% @doc Copy estap test source to target directory, stripping shee-bang lines.
107
108 -spec copy_source(file:name(), file:name()) ->
109   {ok, file:name()} | {error, term()}.
110
111 copy_source(Source, TargetDir) ->
112   Target = filename:join(TargetDir, filename:basename(Source)),
113   case file:read_file(Source) of
114     {ok, Content} ->
115       % adding a comment just before "#!" preserves line numbering, so stack
116       % traces when test case dies are accurate
117       SourceCode = case Content of
118         <<"#!", _/binary>> -> <<"%%% ", Content/binary>>;
119         _ -> Content
120       end,
121       case file:write_file(Target, SourceCode) of
122         ok -> {ok, Target};
123         {error, Reason} -> {error, Reason}
124       end;
125     {error, Reason} ->
126       {error, Reason}
127   end.
128
129 %% @doc Parse specified file to ABF forms.
130
131 -spec parse_file(file:name(), file:name(), [file:name()]) ->
132   {ok, {module(), [erl_parse:abstract_form()]}} | {error, term()}.
133
134 parse_file(File, Source, IncludePath) ->
135   Macros = [],
136   case epp:parse_file(File, IncludePath, Macros) of
137     {ok, Forms} ->
138       % replace name of the file `epp:parse_file()' actually read with the
139       % name of source file, so any possible stack traces mention this source,
140       % not a temporary file
141       {ModuleName, FixedForms} = adjust_forms(Source, Forms),
142       {ok, {ModuleName, FixedForms}};
143     {error, Reason} ->
144       {error, Reason}
145   end.
146
147 %% @doc Adjust ABFs from the test file so they can be safely compiled to
148 %%   a binary module.
149 %%
150 %%   Adjusting consists of setting source file to `SourceFile' (instead of
151 %%   a temporary file it was read from), adding module declaration if it was
152 %%   missing, and adding `test_dir' attribute to
153 %%   `filename:dirname(SourceFile)' (necessary step for
154 %%   {@link estap:test_dir/0} to work).
155
156 -spec adjust_forms(file:name(), [erl_parse:abstract_form()]) ->
157   {module(), [erl_parse:abstract_form()]}.
158
159 adjust_forms(SourceFile, Forms) ->
160   {BeforeModuleForms, AfterModuleForms} = lists:splitwith(
161     fun({attribute,_,module,_}) -> false; (_) -> true end,
162     Forms
163   ),
164   {ModuleName, FormsWithModuleAndDir} = case AfterModuleForms of
165     [{attribute, _, module, Module} = ModForm | Rest] ->
166       % add `test_dir' attribute just after the module declaration
167       DirAttr = {attribute, 0, test_dir, filename:dirname(SourceFile)},
168       {Module, BeforeModuleForms ++ [ModForm, DirAttr | Rest]};
169     [] ->
170       % add module declaration and `test_dir' attribute
171       Module = list_to_atom(filename:rootname(filename:basename(SourceFile))),
172       ModForm = {attribute, 0, module, Module},
173       DirAttr = {attribute, 0, test_dir, filename:dirname(SourceFile)},
174       {Module, [ModForm, DirAttr | BeforeModuleForms]}
175   end,
176   FormsWithProperSourcefile = lists:map(
177     fun
178       ({attribute, N1, file, {_File, N2}}) ->
179         {attribute, N1, file, {SourceFile, N2}};
180       (Form) ->
181         Form
182     end,
183     FormsWithModuleAndDir
184   ),
185   {ModuleName, FormsWithProperSourcefile}.
186
187 %% }}}
188 %%----------------------------------------------------------
189 %% ABF handling functions {{{
190
191 %% @doc Load ABFs as a callable module.
192 %%   Function returns list of tests to run, in order of their appearance.
193
194 -spec load_code([erl_parse:abstract_form()]) ->
195     {ok, {estap_test:test_plan(), [estap_test:test()]}}
196   | {error, sticky_directory | not_purged}.
197
198 load_code(Forms) ->
199   Exports = sets:from_list(exports(Forms)),
200   Tests = tests(Forms),
201   MissingTestExports = [
202     {Fun, 0} ||
203     #test{name = Fun} <- Tests,
204     not sets:is_element({Fun, 0}, Exports)
205   ],
206   % drop all occurrences of `-test()', `-todo()', and `-skip()'
207   ToCompile = lists:filter(
208     fun
209       ({attribute, _, A, _}) when A == test; A == todo; A == skip -> false;
210       (_) -> true
211     end,
212     insert_exports(MissingTestExports, Forms)
213   ),
214   case compile:forms(ToCompile, [return_errors]) of
215     {ok, Module, Binary} ->
216       case code:load_binary(Module, "", Binary) of
217         {module, Module} ->
218           % TODO: indicate whether anything uses the old code
219           code:soft_purge(Module),
220           TestsToReturn = lists:map(
221             fun
222               (#test{name = Name, desc = Desc, todo = {true, Why}}) ->
223                 {{Module, Name}, Desc, {todo, Why}};
224               (#test{name = Name, desc = Desc, skip = {true, Why}}) ->
225                 {{Module, Name}, Desc, {skip, Why}};
226               (#test{name = Name, desc = Desc, todo = false, skip = false}) ->
227                 {{Module, Name}, Desc, run}
228             end,
229             Tests
230           ),
231           case proplists:get_value(plan, Module:module_info(attributes)) of
232             [TestCount] when is_integer(TestCount), TestCount > 0 ->
233               Plan = {plan, TestCount};
234             _ ->
235               Plan = no_plan
236           end,
237           {ok, {Plan, TestsToReturn}};
238         {error, Reason} ->
239           {error, Reason}
240       end;
241     {error, Errors, _Warnings} ->
242       {error, {parse_errors, Errors}}
243   end.
244
245 %% @doc Insert specified exports in list of ABFs for the module.
246
247 insert_exports(Exports, [{attribute,_,module,_} = Attr | Rest] = _Forms) ->
248   [Attr, {attribute, 0, export, Exports} | Rest];
249 insert_exports(Exports, [Attr | Rest] = _Forms) ->
250   [Attr | insert_exports(Exports, Rest)].
251
252 %% @doc Extract from list of ABFs functions that are tests to be run.
253
254 -spec tests([erl_parse:abstract_form()]) ->
255   [#test{}].
256
257 tests(Forms) ->
258   tests(Forms, #test{}).
259
260 %% @doc Extract from list of ABFs functions that are tests to be run.
261 %%   Worker function for {@link tests/1}.
262
263 -spec tests([erl_parse:abstract_form()], #test{}) ->
264   [#test{}].
265
266 tests([] = _Forms, _Test) ->
267   [];
268
269 tests([{attribute, _Line, test, Desc} | Rest] = _Forms, Test) ->
270   tests(Rest, Test#test{desc = Desc});
271
272 tests([{attribute, _Line, todo, Reason} | Rest] = _Forms, Test) ->
273   tests(Rest, Test#test{todo = {true, Reason}});
274
275 tests([{attribute, _Line, skip, Reason} | Rest] = _Forms, Test) ->
276   tests(Rest, Test#test{skip = {true, Reason}});
277
278 tests([{function, _Line, FName, 0, _Body} | Rest] = _Forms, Test) ->
279   case Test of
280     #test{desc = undefined} ->
281       % TODO: check if `FName' ends with `"_test"'
282       tests(Rest, Test);
283     #test{desc = Desc} when is_list(Desc) ->
284       [Test#test{name = FName} | tests(Rest, #test{})]
285   end;
286
287 tests([{function, _Line, _FName, _Arity, _Body} | Rest] = _Forms, _Test) ->
288   % reset attributes
289   tests(Rest, #test{});
290
291 tests([_Any | Rest] = _Forms, Test) ->
292   tests(Rest, Test).
293
294 %% @doc Extract exports from the module.
295
296 -spec exports([erl_parse:abstract_form()]) ->
297   [{atom(), byte()}].
298
299 exports(Forms) ->
300   Exports = [Fs || {attribute, _Line, export, Fs} <- Forms],
301   lists:flatten(Exports).
302
303 %% }}}
304 %%----------------------------------------------------------
305
306 %%%---------------------------------------------------------------------------
307 %%% vim:ft=erlang:foldmethod=marker