1%% ``Licensed under the Apache License, Version 2.0 (the "License");
2%% you may not use this file except in compliance with the License.
3%% You may obtain a copy of the License at
4%%
5%%     http://www.apache.org/licenses/LICENSE-2.0
6%%
7%% Unless required by applicable law or agreed to in writing, software
8%% distributed under the License is distributed on an "AS IS" BASIS,
9%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
10%% See the License for the specific language governing permissions and
11%% limitations under the License.
12%%
13%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
14%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
15%% AB. All Rights Reserved.''
16
17-module(syntax_tools_SUITE).
18
19-include_lib("common_test/include/ct.hrl").
20
21%% Test server specific exports
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
25%% Test cases
26-export([app_test/1,appup_test/1,smoke_test/1,revert/1,revert_map/1,
27         revert_map_type/1,wrapped_subtrees/1,
28         t_abstract_type/1,t_erl_parse_type/1,t_type/1,
29         t_epp_dodger/1,t_epp_dodger_clever/1,
30	t_comment_scan/1,t_igor/1,t_erl_tidy/1,t_prettypr/1]).
31
32suite() -> [{ct_hooks,[ts_install_cth]}].
33
34all() ->
35    [app_test,appup_test,smoke_test,revert,revert_map,revert_map_type,
36     wrapped_subtrees,
37     t_abstract_type,t_erl_parse_type,t_type,
38     t_epp_dodger,t_epp_dodger_clever,
39    t_comment_scan,t_igor,t_erl_tidy,t_prettypr].
40
41groups() ->
42    [].
43
44init_per_suite(Config) ->
45    Config.
46
47end_per_suite(_Config) ->
48    ok.
49
50init_per_group(_GroupName, Config) ->
51    Config.
52
53end_per_group(_GroupName, Config) ->
54    Config.
55
56app_test(Config) when is_list(Config) ->
57    ok = ?t:app_test(syntax_tools).
58
59appup_test(Config) when is_list(Config) ->
60    ok = ?t:appup_test(syntax_tools).
61
62%% Read and parse all source in the OTP release.
63smoke_test(Config) when is_list(Config) ->
64    Dog = ?t:timetrap(?t:minutes(12)),
65    Wc = filename:join([code:lib_dir(),"*","src","*.erl"]),
66    Fs = filelib:wildcard(Wc) ++ test_files(Config),
67    io:format("~p files\n", [length(Fs)]),
68    case p_run(fun smoke_test_file/1, Fs) of
69        0 -> ok;
70        N -> ?t:fail({N,errors})
71    end,
72    ?t:timetrap_cancel(Dog).
73
74smoke_test_file(File) ->
75    case epp_dodger:parse_file(File) of
76	{ok,Forms} ->
77	    [print_error_markers(F, File) || F <- Forms],
78	    ok;
79	{error,Reason} ->
80	    io:format("~ts: ~p\n", [File,Reason]),
81	    error
82    end.
83
84print_error_markers(F, File) ->
85    case erl_syntax:type(F) of
86	error_marker ->
87	    {L,M,Info} = erl_syntax:error_marker_info(F),
88	    io:format("~ts:~p: ~ts", [File,L,M:format_error(Info)]);
89	_ ->
90	    ok
91    end.
92
93
94%% Read with erl_parse, wrap and revert with erl_syntax and check for equality.
95revert(Config) when is_list(Config) ->
96    Dog = ?t:timetrap(?t:minutes(12)),
97    Wc = filename:join([code:lib_dir("stdlib"),"src","*.erl"]),
98    Fs = filelib:wildcard(Wc) ++ test_files(Config),
99    Path = [filename:join(code:lib_dir(stdlib), "include"),
100            filename:join(code:lib_dir(kernel), "include")],
101    io:format("~p files\n", [length(Fs)]),
102    case p_run(fun (File) -> revert_file(File, Path) end, Fs) of
103        0 -> ok;
104        N -> ?t:fail({N,errors})
105        end,
106    ?t:timetrap_cancel(Dog).
107
108revert_file(File, Path) ->
109    case epp:parse_file(File, Path, []) of
110        {ok,Fs0} ->
111            Fs1 = erl_syntax:form_list(Fs0),
112            Fs2 = erl_syntax_lib:map(fun (Node) -> Node end, Fs1),
113            Fs3 = erl_syntax:form_list_elements(Fs2),
114            Fs4 = [ erl_syntax:revert(Form) || Form <- Fs3 ],
115            {ok,_} = compile:forms(Fs4, [report,strong_validation]),
116            ok
117    end.
118
119%% Testing bug fix for reverting map_field_assoc
120revert_map(Config) when is_list(Config) ->
121    Dog = ?t:timetrap(?t:minutes(1)),
122    [{map_field_assoc,16,{atom,17,name},{var,18,'Value'}}] =
123    erl_syntax:revert_forms([{tree,map_field_assoc,
124                             {attr,16,[],none},
125			     {map_field_assoc,{atom,17,name},{var,18,'Value'}}}]),
126    ?t:timetrap_cancel(Dog).
127
128%% Testing bug fix for reverting map_field_assoc in types
129revert_map_type(Config) when is_list(Config) ->
130    Dog = ?t:timetrap(?t:minutes(1)),
131    Form1 = {attribute,4,record,
132             {state,
133              [{typed_record_field,
134                {record_field,5,{atom,5,x}},
135                {type,5,map,
136                 [{type,5,map_field_exact,[{atom,5,y},{atom,5,z}]}]}}]}},
137    Mapped1 = erl_syntax_lib:map(fun(X) -> X end, Form1),
138    Form1 = erl_syntax:revert(Mapped1),
139    Form2 = {attribute,4,record,
140             {state,
141              [{typed_record_field,
142                {record_field,5,{atom,5,x}},
143                {type,5,map,
144                 [{type,5,map_field_assoc,[{atom,5,y},{atom,5,z}]}]}}]}},
145    Mapped2 = erl_syntax_lib:map(fun(X) -> X end, Form2),
146    Form2 = erl_syntax:revert(Mapped2),
147    ?t:timetrap_cancel(Dog).
148
149%% Read with erl_parse, wrap each tree node with erl_syntax and check that
150%% erl_syntax:subtrees can access the wrapped node.
151wrapped_subtrees(Config) when is_list(Config) ->
152    Dog = ?t:timetrap(?t:minutes(2)),
153    Wc = filename:join([code:lib_dir(stdlib),"src","*.erl"]),
154    Fs = filelib:wildcard(Wc) ++ test_files(Config),
155    Path = [filename:join(code:lib_dir(stdlib), "include"),
156            filename:join(code:lib_dir(kernel), "include")],
157    io:format("~p files\n", [length(Fs)]),
158    Map = fun (File) -> wrapped_subtrees_file(File, Path) end,
159    case p_run(Map, Fs) of
160        0 -> ok;
161        N -> ?t:fail({N,errors})
162    end,
163    ?t:timetrap_cancel(Dog).
164
165wrapped_subtrees_file(File, Path) ->
166    case epp:parse_file(File, Path, []) of
167        {ok,Fs0} ->
168            lists:foreach(fun wrap_each/1, Fs0)
169    end.
170
171wrap_each(Tree) ->
172    % only `wrap` top-level erl_parse node
173    Tree1 = erl_syntax:set_pos(Tree, erl_syntax:get_pos(Tree)),
174    % assert ability to access subtrees of wrapped node with erl_syntax:subtrees/1
175    case erl_syntax:subtrees(Tree1) of
176        [] -> ok;
177        List ->
178            GrpsF = fun(Group) ->
179                          lists:foreach(fun wrap_each/1, Group)
180                    end,
181            lists:foreach(GrpsF, List)
182    end.
183
184%% api tests
185
186t_type(Config) when is_list(Config) ->
187    F0 = fun validate_basic_type/1,
188    Appl0 = fun(Name) ->
189                    Atom = erl_syntax:atom(Name),
190                    erl_syntax:type_application(none, Atom, [])
191            end,
192    User0 = fun(Name) ->
193                    Atom = erl_syntax:atom(Name),
194                    erl_syntax:user_type_application(Atom, [])
195            end,
196    ok = validate(F0,[{"tuple()", erl_syntax:tuple_type()}
197                     ,{"{}", erl_syntax:tuple_type([])}
198                     ,{"integer()", Appl0(integer)}
199                     ,{"foo()", User0(foo)}
200                     ,{"map()", erl_syntax:map_type()}
201                     ,{"#{}", erl_syntax:map_type([])}
202                     ,{"1..2", erl_syntax:integer_range_type
203                          (erl_syntax:integer(1), erl_syntax:integer(2))}
204                     ,{"<<_:1,_:_*2>>", erl_syntax:bitstring_type
205                          (erl_syntax:integer(1), erl_syntax:integer(2))}
206                     ,{"fun()", erl_syntax:fun_type()}
207                     ]),
208
209    F = fun validate_type/1,
210    ok = validate(F,[{"{}", tuple_type, false}
211                    ,{"tuple()", tuple_type, true}
212                    ,{"{atom()}", tuple_type, false}
213                    ,{"{atom(),integer()}", tuple_type, false}
214                    ,{"integer()", type_application, false}
215                    ,{"foo()", user_type_application, false}
216                    ,{"foo(integer())", user_type_application, false}
217                    ,{"module:function()", type_application, false}
218                    ,{"map()", map_type, true}
219                    ,{"#{}", map_type, false}
220                    ,{"#{atom() => integer()}", map_type, false}
221                    ,{"#{atom() := integer()}", map_type, false}
222                    ,{"#r{}", record_type, false}
223                    ,{"#r{a :: integer()}", record_type, false}
224                    ,{"[]", type_application, false}
225                    ,{"nil()", type_application, false}
226                    ,{"[atom()]", type_application, false}
227                    ,{"1..2", integer_range_type, false}
228                    ,{"<<_:1,_:_*2>>", bitstring_type, false}
229                    ,{"fun()", fun_type, true}
230                    ,{"integer() | atom()", type_union, false}
231                    ,{"A :: fun()", annotated_type, false}
232                    ,{"fun((...) -> atom())", function_type, false}
233                    ,{"fun((integer()) -> atom())", function_type, false}
234                    ,{"V", variable, true}
235                    ]),
236    ok.
237
238validate_basic_type({String, Tree}) ->
239    ErlT = string_to_type(String),
240    ErlT = erl_syntax:revert(Tree),
241    ok.
242
243validate_type({String, Type, Leaf}) ->
244    ErlT = string_to_type(String),
245    Type = erl_syntax:type(ErlT),
246    Leaf = erl_syntax:is_leaf(ErlT),
247    Tree = erl_syntax_lib:map(fun(Node) -> Node end, ErlT),
248    Type = erl_syntax:type(Tree),
249    _    = erl_syntax:meta(Tree),
250    RevT = erl_syntax:revert(Tree),
251    Type = erl_syntax:type(RevT),
252    ok.
253
254t_abstract_type(Config) when is_list(Config) ->
255    F = fun validate_abstract_type/1,
256    ok = validate(F,[{hi,atom},
257		     {1,integer},
258		     {1.0,float},
259		     {$a,integer},
260		     {[],nil},
261		     {[<<1,2>>,a,b],list},
262		     {[2,3,<<1,2>>,a,b],list},
263		     {[$a,$b,$c],string},
264		     {"hello world",string},
265		     {<<1,2,3>>,binary},
266                     {<<1,2,3:4>>,binary},
267		     {#{a=>1,"b"=>2},map_expr},
268		     {#{#{i=>1}=>1,"b"=>#{v=>2}},map_expr},
269		     {{a,b,c},tuple}]),
270    ok.
271
272t_erl_parse_type(Config) when is_list(Config) ->
273    F = fun validate_erl_parse_type/1,
274    %% leaf types
275    ok = validate(F,[{"1",integer,true},
276		     {"123456789",integer,true},
277		     {"$h", char,true},
278		     {"3.1415", float,true},
279		     {"1.33e36", float,true},
280		     {"\"1.33e36: hello\"", string,true},
281		     {"Var1", variable,true},
282		     {"_", underscore,true},
283		     {"[]", nil,true},
284		     {"{}", tuple,true},
285		     {"#{}",map_expr,true},
286		     {"'some atom'", atom, true}]),
287    %% composite types
288    ok = validate(F,[{"case X of t -> t; f -> f end", case_expr,false},
289		     {"try X of t -> t catch C:R -> error end", try_expr,false},
290		     {"receive X -> X end", receive_expr,false},
291		     {"receive M -> X1 after T -> X2 end", receive_expr,false},
292		     {"catch (X)", catch_expr,false},
293		     {"fun(X) -> X end", fun_expr,false},
294		     {"fun Foo(X) -> X end", named_fun_expr,false},
295		     {"fun foo/2", implicit_fun,false},
296		     {"fun bar:foo/2", implicit_fun,false},
297		     {"if X -> t; true -> f end", if_expr,false},
298		     {"<<1,2,3,4>>", binary,false},
299		     {"<<1,2,3,4:5>>", binary,false},
300		     {"<<V1:63,V2:22/binary, V3/bits>>", binary,false},
301		     {"begin X end", block_expr,false},
302		     {"foo(X1,X2)", application,false},
303		     {"bar:foo(X1,X2)", application,false},
304		     {"[1,2,3,4]", list,false},
305		     {"[1|4]", list, false},
306		     {"[<<1>>,<<2>>,-2,<<>>,[more,list]]", list,false},
307		     {"[1|[2|[3|[4|[]]]]]", list,false},
308		     {"#{ a=>1, b=>2 }", map_expr,false},
309		     {"#{3=>3}#{ a=>1, b=>2 }", map_expr,false},
310		     {"#{ a:=1, b:=2 }", map_expr,false},
311		     {"M#{ a=>1, b=>2 }", map_expr,false},
312		     {"[V||V <- Vs]", list_comp,false},
313		     {"<< <<B>> || <<B>> <= Bs>>", binary_comp,false},
314		     {"#state{ a = A, b = B}", record_expr,false},
315		     {"#state{}", record_expr,false},
316		     {"#s{ a = #def{ a=A }, b = B}", record_expr,false},
317		     {"State#state{ a = A, b = B}", record_expr,false},
318		     {"State#state.a", record_access,false},
319		     {"#state.a", record_index_expr,false},
320		     {"-X", prefix_expr,false},
321		     {"X1 + X2", infix_expr,false},
322		     {"(X1 + X2) * X3", infix_expr,false},
323		     {"X1 = X2", match_expr,false},
324		     {"{a,b,c}", tuple,false}]),
325    ok.
326
327%% the macro ?MODULE seems faulty
328t_epp_dodger(Config) when is_list(Config) ->
329    DataDir   = ?config(data_dir, Config),
330    PrivDir   = ?config(priv_dir, Config),
331    Filenames = test_files(),
332    ok = test_epp_dodger(Filenames,DataDir,PrivDir),
333    ok.
334
335t_epp_dodger_clever(Config) when is_list(Config) ->
336    DataDir   = ?config(data_dir, Config),
337    PrivDir   = ?config(priv_dir, Config),
338    Filenames = ["epp_dodger_clever.erl"],
339    ok = test_epp_dodger_clever(Filenames,DataDir,PrivDir),
340    ok.
341
342t_comment_scan(Config) when is_list(Config) ->
343    DataDir   = ?config(data_dir, Config),
344    Filenames = test_files(),
345    ok = test_comment_scan(Filenames,DataDir),
346    ok.
347
348t_prettypr(Config) when is_list(Config) ->
349    DataDir   = ?config(data_dir, Config),
350    PrivDir   = ?config(priv_dir, Config),
351    Filenames = ["type_specs.erl",
352                 "specs_and_funs.erl"],
353    ok = test_prettypr(Filenames,DataDir,PrivDir),
354    ok.
355
356test_files(Config) ->
357    DataDir = ?config(data_dir, Config),
358    [ filename:join(DataDir,Filename) || Filename <- test_files() ].
359
360test_files() ->
361    ["syntax_tools_SUITE_test_module.erl",
362     "syntax_tools_test.erl",
363     "type_specs.erl",
364     "specs_and_funs.erl"].
365
366t_igor(Config) when is_list(Config) ->
367    DataDir   = ?config(data_dir, Config),
368    PrivDir   = ?config(priv_dir, Config),
369    FileM1  = filename:join(DataDir,"m1.erl"),
370    FileM2  = filename:join(DataDir,"m2.erl"),
371    ["m.erl",_]=R = igor:merge(m,[FileM1,FileM2],[{outdir,PrivDir}]),
372    io:format("igor:merge/3 = ~p~n", [R]),
373
374    FileTypeSpecs = filename:join(DataDir,"igor_type_specs.erl"),
375    Empty = filename:join(DataDir,"empty.erl"),
376    ["n.erl",_]=R2 = igor:merge(n,[FileTypeSpecs,Empty],[{outdir,PrivDir}]),
377    io:format("igor:merge/3 = ~p~n", [R2]),
378
379    ok.
380
381t_erl_tidy(Config) when is_list(Config) ->
382    DataDir   = ?config(data_dir, Config),
383    File  = filename:join(DataDir,"erl_tidy_tilde.erl"),
384    ok = erl_tidy:file(File, [{stdout, true}]),
385
386    %% OTP-14471.
387    Old = process_flag(trap_exit, true),
388    NonExisting  = filename:join(DataDir,"non_existing_file.erl"),
389    {'EXIT',{error,{0,file,enoent}}} = (catch erl_tidy:file(NonExisting)),
390    true = process_flag(trap_exit, Old),
391    ok.
392
393test_comment_scan([],_) -> ok;
394test_comment_scan([File|Files],DataDir) ->
395    Filename  = filename:join(DataDir,File),
396    {ok, Fs0} = epp:parse_file(Filename, [], []),
397    Comments  = erl_comment_scan:file(Filename),
398    Fun = fun(Node) ->
399		  case erl_syntax:is_form(Node) of
400		      true ->
401			  C1    = erl_syntax:comment(2,[" This is a form."]),
402			  Node1 = erl_syntax:add_precomments([C1],Node),
403			  Node1;
404		      false ->
405			  Node
406		  end
407	  end,
408    Fs1 = erl_recomment:recomment_forms(Fs0, Comments),
409    Fs2 = erl_syntax_lib:map(Fun, Fs1),
410    io:format("File: ~ts~n", [Filename]),
411    io:put_chars(erl_prettypr:format(Fs2, [{paper,  120},
412					   {ribbon, 110}])),
413    test_comment_scan(Files,DataDir).
414
415
416test_prettypr([],_,_) -> ok;
417test_prettypr([File|Files],DataDir,PrivDir) ->
418    Filename  = filename:join(DataDir,File),
419    io:format("Parsing ~p~n", [Filename]),
420    {ok, Fs0} = epp:parse_file(Filename, [], []),
421    Fs = erl_syntax:form_list(Fs0),
422    PP = erl_prettypr:format(Fs, [{paper,  120}, {ribbon, 110}]),
423    io:put_chars(PP),
424    OutFile = filename:join(PrivDir, File),
425    ok = file:write_file(OutFile,unicode:characters_to_binary(PP)),
426    io:format("Parsing OutFile: ~ts~n", [OutFile]),
427    {ok, Fs2} = epp:parse_file(OutFile, [], []),
428    case [Error || {error, _} = Error <- Fs2] of
429        [] ->
430            ok;
431        Errors ->
432            ?t:fail(Errors)
433    end,
434    test_prettypr(Files,DataDir,PrivDir).
435
436
437test_epp_dodger([], _, _) -> ok;
438test_epp_dodger([Filename|Files],DataDir,PrivDir) ->
439    io:format("Parsing ~p~n", [Filename]),
440    InFile   = filename:join(DataDir, Filename),
441    Parsers  = [{fun epp_dodger:parse_file/1,parse_file},
442		{fun epp_dodger:quick_parse_file/1,quick_parse_file},
443		{fun (File) ->
444			{ok,Dev} = file:open(File,[read]),
445			Res = epp_dodger:parse(Dev),
446			file:close(File),
447			Res
448		 end, parse},
449		{fun (File) ->
450			{ok,Dev} = file:open(File,[read]),
451			Res = epp_dodger:quick_parse(Dev),
452			file:close(File),
453			Res
454		 end, quick_parse}],
455    FsForms  = parse_with(Parsers, InFile),
456    ok = pretty_print_parse_forms(FsForms,PrivDir,Filename),
457    test_epp_dodger(Files,DataDir,PrivDir).
458
459test_epp_dodger_clever([], _, _) -> ok;
460test_epp_dodger_clever([Filename|Files],DataDir,PrivDir) ->
461    io:format("Parsing ~p~n", [Filename]),
462    InFile   = filename:join(DataDir, Filename),
463    Parsers  = [{fun(File) ->
464                         epp_dodger:parse_file(File, [clever])
465                 end, parse_file},
466		{fun(File) ->
467                         epp_dodger:quick_parse_file(File, [clever])
468                 end, quick_parse_file}],
469    FsForms  = parse_with(Parsers, InFile),
470    ok = pretty_print_parse_forms(FsForms,PrivDir,Filename),
471    test_epp_dodger_clever(Files,DataDir,PrivDir).
472
473parse_with([],_) -> [];
474parse_with([{Fun,ParserType}|Funs],File) ->
475    {ok, Fs} = Fun(File),
476    ErrorMarkers = [begin
477                        print_error_markers(F, File),
478                        F
479                    end
480                    || F <- Fs,
481                       erl_syntax:type(F) =:= error_marker],
482    [] = ErrorMarkers,
483    [{Fs,ParserType}|parse_with(Funs,File)].
484
485pretty_print_parse_forms([],_,_) -> ok;
486pretty_print_parse_forms([{Fs0,Type}|FsForms],PrivDir,Filename) ->
487    Parser  = atom_to_list(Type),
488    OutFile = filename:join(PrivDir, Parser ++"_" ++ Filename),
489    io:format("Pretty print ~p (~w) to ~p~n", [Filename,Type,OutFile]),
490    Comment = fun (Node,{CntCase,CntTry}=Cnt) ->
491		      case erl_syntax:type(Node) of
492			  case_expr ->
493			      C1    = erl_syntax:comment(2,["Before a case expression"]),
494			      Node1 = erl_syntax:add_precomments([C1],Node),
495			      C2    = erl_syntax:comment(2,["After a case expression"]),
496			      Node2 = erl_syntax:add_postcomments([C2],Node1),
497			      {Node2,{CntCase+1,CntTry}};
498			  try_expr ->
499			      C1    = erl_syntax:comment(2,["Before a try expression"]),
500			      Node1 = erl_syntax:set_precomments(Node,
501						     erl_syntax:get_precomments(Node) ++ [C1]),
502			      C2    = erl_syntax:comment(2,["After a try expression"]),
503			      Node2 = erl_syntax:set_postcomments(Node1,
504						     erl_syntax:get_postcomments(Node1) ++ [C2]),
505			      {Node2,{CntCase,CntTry+1}};
506			  _ ->
507			      {Node,Cnt}
508		      end
509	      end,
510    Fs1 = erl_syntax:form_list(Fs0),
511    {Fs2,{CC,CT}} = erl_syntax_lib:mapfold(Comment,{0,0}, Fs1),
512    io:format("Commented on ~w cases and ~w tries~n", [CC,CT]),
513    PP  = erl_prettypr:format(Fs2),
514    ok  = file:write_file(OutFile,unicode:characters_to_binary(PP)),
515    pretty_print_parse_forms(FsForms,PrivDir,Filename).
516
517
518validate(_,[]) -> ok;
519validate(F,[V|Vs]) ->
520    ok = F(V),
521    validate(F,Vs).
522
523
524validate_abstract_type({Lit,Type}) ->
525    Tree = erl_syntax:abstract(Lit),
526    ok   = validate_special_type(Type,Tree),
527    Type = erl_syntax:type(Tree),
528    true = erl_syntax:is_literal(Tree),
529    ErlT = erl_syntax:revert(Tree),
530    Type = erl_syntax:type(ErlT),
531    ok   = validate_special_type(Type,ErlT),
532    Conc = erl_syntax:concrete(Tree),
533    Lit  = Conc,
534    ok.
535
536validate_erl_parse_type({String,Type,Leaf}) ->
537    ErlT = string_to_expr(String),
538    ok   = validate_special_type(Type,ErlT),
539    Type = erl_syntax:type(ErlT),
540    Leaf = erl_syntax:is_leaf(ErlT),
541    Tree = erl_syntax_lib:map(fun(Node) -> Node end, ErlT),
542    Type = erl_syntax:type(Tree),
543    _    = erl_syntax:meta(Tree),
544    ok   = validate_special_type(Type,Tree),
545    RevT = erl_syntax:revert(Tree),
546    ok   = validate_special_type(Type,RevT),
547    Type = erl_syntax:type(RevT),
548    ok.
549
550validate_special_type(string,Node) ->
551    Val  = erl_syntax:string_value(Node),
552    true = erl_syntax:is_string(Node,Val),
553    _    = erl_syntax:string_literal(Node),
554    ok;
555validate_special_type(variable,Node) ->
556    _ = erl_syntax:variable_literal(Node),
557    ok;
558validate_special_type(fun_expr,Node) ->
559    A = erl_syntax:fun_expr_arity(Node),
560    true = is_integer(A),
561    ok;
562validate_special_type(named_fun_expr,Node) ->
563    A = erl_syntax:named_fun_expr_arity(Node),
564    true = is_integer(A),
565    ok;
566validate_special_type(tuple,Node) ->
567    Size = erl_syntax:tuple_size(Node),
568    true = is_integer(Size),
569    ok;
570validate_special_type(float,Node) ->
571    Str   = erl_syntax:float_literal(Node),
572    Val   = list_to_float(Str),
573    Val   = erl_syntax:float_value(Node),
574    false = erl_syntax:is_proper_list(Node),
575    false = erl_syntax:is_list_skeleton(Node),
576    ok;
577validate_special_type(integer,Node) ->
578    Str   = erl_syntax:integer_literal(Node),
579    Val   = list_to_integer(Str),
580    true  = erl_syntax:is_integer(Node,Val),
581    Val   = erl_syntax:integer_value(Node),
582    false = erl_syntax:is_proper_list(Node),
583    ok;
584validate_special_type(nil,Node) ->
585    true  = erl_syntax:is_proper_list(Node),
586    ok;
587validate_special_type(list,Node) ->
588    true  = erl_syntax:is_list_skeleton(Node),
589    _     = erl_syntax:list_tail(Node),
590    ErrV  = erl_syntax:list_head(Node),
591    false = erl_syntax:is_string(Node,ErrV),
592    Norm  = erl_syntax:normalize_list(Node),
593    list  = erl_syntax:type(Norm),
594    case erl_syntax:is_proper_list(Node) of
595	true ->
596	    true = erl_syntax:is_list_skeleton(Node),
597	    Compact = erl_syntax:compact_list(Node),
598	    list = erl_syntax:type(Compact),
599	    [_|_] = erl_syntax:list_elements(Node),
600	    _  = erl_syntax:list_elements(Node),
601	    N  = erl_syntax:list_length(Node),
602	    true = N > 0,
603	    ok;
604	false ->
605	    ok
606    end;
607validate_special_type(_,_) ->
608    ok.
609
610%%% scan_and_parse
611
612string_to_expr(String) ->
613    io:format("Str: ~p~n", [String]),
614    {ok, Ts, _} = erl_scan:string(String++"."),
615    {ok,[Expr]} = erl_parse:parse_exprs(Ts),
616    Expr.
617
618string_to_type(String) ->
619    io:format("Str: ~p~n", [String]),
620    {ok,Ts,_} = erl_scan:string("-type foo() :: "++String++".", 0),
621    {ok,Form} = erl_parse:parse_form(Ts),
622    {attribute,_,type,{foo,Type,_NoParms=[]}} = Form,
623    Type.
624
625
626p_run(Test, List) ->
627    N = erlang:system_info(schedulers),
628    p_run_loop(Test, List, N, [], 0).
629
630p_run_loop(_, [], _, [], Errors) ->
631    Errors;
632p_run_loop(Test, [H|T], N, Refs, Errors) when length(Refs) < N ->
633    {_,Ref} = erlang:spawn_monitor(fun() -> exit(Test(H)) end),
634    p_run_loop(Test, T, N, [Ref|Refs], Errors);
635p_run_loop(Test, List, N, Refs0, Errors0) ->
636    receive
637	{'DOWN',Ref,process,_,Res} ->
638	    Errors = case Res of
639			 ok -> Errors0;
640			 error -> Errors0+1
641		     end,
642	    Refs = Refs0 -- [Ref],
643	    p_run_loop(Test, List, N, Refs, Errors)
644    end.
645