1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1998-2016. 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%%----------------------------------------------------------------------
22%% Purpose : Test suite for the IDL preprocessor
23%%----------------------------------------------------------------------
24
25-module(ic_pp_SUITE).
26-include_lib("common_test/include/ct.hrl").
27
28
29
30%% Standard options to the ic compiler, NOTE unholy use of OutDir
31
32-define(OUT(X), filename:join([proplists:get_value(priv_dir, Config), gen, to_list(X)])).
33-define(GCC, "g++").
34-define(GCC_VER, "2.95.3").
35
36-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
37-export([arg_norm/1]).
38-export([cascade_norm/1]).
39-export([comment_norm/1]).
40-export([concat_norm/1]).
41-export([define_norm/1]).
42-export([if_norm/1]).
43-export([if_zero/1]).
44-export([misc_norm/1]).
45-export([improp_nest_constr_norm/1]).
46-export([inc_norm/1]).
47-export([line_norm/1]).
48-export([nopara_norm/1]).
49-export([predef_norm/1]).
50-export([predef_time_norm/1]).
51-export([self_ref_norm/1]).
52-export([separate_norm/1]).
53-export([swallow_sc_norm/1]).
54-export([unintended_grp_norm/1]).
55-export([cases/0, init_per_suite/1, end_per_suite/1]).
56
57
58suite() -> [{ct_hooks,[ts_install_cth]}].
59
60all() ->
61    cases().
62
63groups() ->
64    [{arg, [], [arg_norm]}, {cascade, [], [cascade_norm]},
65     {comment, [], [comment_norm]},
66     {concat, [], [concat_norm]},
67     {define, [], [define_norm]}, {inc, [], [inc_norm]},
68     {improp_nest_constr, [], [improp_nest_constr_norm]},
69     {misc, [], [misc_norm]}, {line, [], [line_norm]},
70     {nopara, [], [nopara_norm]},
71     {predef, [], [predef_norm]},
72     {predef_time, [], [predef_time_norm]},
73     {self_ref, [], [self_ref_norm]},
74     {separate, [], [separate_norm]},
75     {swallow_sc, [], [swallow_sc_norm]},
76     {unintended_grp, [], [unintended_grp_norm]},
77     {'if', [],[if_norm, if_zero]}].
78
79init_per_group(_GroupName, Config) ->
80	Config.
81
82end_per_group(_GroupName, Config) ->
83	Config.
84
85
86init_per_suite(Config) ->
87    if
88	is_list(Config) ->
89	    case os:type() of
90		{win32, _} ->
91		    {skipped, "Very unplesent to run on windows"};
92		_ ->
93		    check_gcc(Config)
94	    end;
95	true ->
96	    exit("Config not a list")
97    end.
98
99check_gcc(Config) ->
100    case os:find_executable(?GCC) of
101	false ->
102	    {skipped,
103	     lists:flatten(io_lib:format("Can not run without ~s in path",
104					 [?GCC]))};
105	_ ->
106	    case trim(os:cmd(?GCC++" --version")) of
107		?GCC_VER++[] ->
108		    Config;
109		?GCC_VER++[D|_] when is_integer(D), D>=$0, D=<$9 ->
110		    fail_gcc(?GCC_VER++[D]);
111		?GCC_VER++_ ->
112		    Config;
113		Ver ->
114		    fail_gcc(Ver)
115	    end
116    end.
117
118fail_gcc(Ver) ->
119    {skipped, lists:flatten(io_lib:format("Need ~s v~s, not ~s",
120					  [?GCC, ?GCC_VER, Ver]))}.
121
122trim(S) -> lists:reverse(skip_white(lists:reverse(skip_white(S)))).
123
124skip_white([$\s|T]) -> skip_white(T);
125skip_white([$\n|T]) -> skip_white(T);
126skip_white([$\r|T]) -> skip_white(T);
127skip_white([$\t|T]) -> skip_white(T);
128skip_white(L) -> L.
129
130
131end_per_suite(Config) ->
132    Config.
133
134
135cases() ->
136    [{group, arg}, {group, cascade}, {group, comment},
137     {group, concat}, {group, define}, {group, misc}, {group, 'if'},
138     {group, improp_nest_constr}, {group, inc},
139     {group, line}, {group, nopara}, {group, predef},
140     {group, predef_time}, {group, self_ref},
141     {group, separate}, {group, swallow_sc},
142     {group, unintended_grp}].
143
144
145
146%%--------------------------------------------------------------------
147%% arg
148%%--------------------------------------------------------------------
149%% Checks arguments for #define.
150arg_norm(Config) when is_list(Config) ->
151    DataDir = proplists:get_value(data_dir, Config),
152    _OutDir = ?OUT(arg_norm),
153    File = filename:join(DataDir, arg),
154
155    ok = test_file(File, DataDir),
156    ok.
157
158
159%%--------------------------------------------------------------------
160%% cascade
161%%--------------------------------------------------------------------
162%% Check cascade #define.
163cascade_norm(Config) when is_list(Config) ->
164    DataDir = proplists:get_value(data_dir, Config),
165    _OutDir = ?OUT(cascade_norm),
166    File = filename:join(DataDir, cascade),
167
168    ok = test_file(File, DataDir),
169    ok.
170
171
172%%--------------------------------------------------------------------
173%% comment
174%%--------------------------------------------------------------------
175%% Check comments.
176comment_norm(Config) when is_list(Config) ->
177    DataDir = proplists:get_value(data_dir, Config),
178    _OutDir = ?OUT(comment_norm),
179    File = filename:join(DataDir, comment),
180
181    ok = test_file(File, DataDir),
182    ok.
183
184
185%%--------------------------------------------------------------------
186%% concat
187%%--------------------------------------------------------------------
188%% Check concatinations, i.e ## .
189concat_norm(Config) when is_list(Config) ->
190    DataDir = proplists:get_value(data_dir, Config),
191    _OutDir = ?OUT(concat_norm),
192    File = filename:join(DataDir, concat),
193
194    ok = test_file(File, DataDir),
195    ok.
196
197
198%%--------------------------------------------------------------------
199%% define
200%%--------------------------------------------------------------------
201%% Check misceleaneous #define.
202define_norm(Config) when is_list(Config) ->
203    DataDir = proplists:get_value(data_dir, Config),
204    _OutDir = ?OUT(define_norm),
205    File = filename:join(DataDir, define),
206
207    ok = test_file(File, DataDir),
208    ok.
209
210
211%%--------------------------------------------------------------------
212%% if
213%%--------------------------------------------------------------------
214%% Check #if, #elif, and #endif.
215if_norm(Config) when is_list(Config) ->
216    DataDir = proplists:get_value(data_dir, Config),
217    _OutDir = ?OUT(if_norm),
218    File = filename:join(DataDir, 'if'),
219
220    ok = test_file(File, DataDir),
221    ok.
222
223%% Check #if 0
224if_zero(Config) when is_list(Config) ->
225    DataDir = proplists:get_value(data_dir, Config),
226    _OutDir = ?OUT(if_zero),
227    File = filename:join(DataDir, if_zero),
228
229    ok = test_file(File, DataDir),
230    ok.
231
232
233%%--------------------------------------------------------------------
234%% inc
235%%--------------------------------------------------------------------
236%% Check #include.
237inc_norm(Config) when is_list(Config) ->
238    DataDir = proplists:get_value(data_dir, Config),
239    _OutDir = ?OUT(inc_norm),
240    File = filename:join(DataDir, inc),
241
242    ok = test_file(File, DataDir),
243    ok.
244
245
246
247%%--------------------------------------------------------------------
248%% improp_nest_constr
249%%--------------------------------------------------------------------
250%% Check improperly nested constructs.
251improp_nest_constr_norm(Config) when is_list(Config) ->
252    DataDir = proplists:get_value(data_dir, Config),
253    _OutDir = ?OUT(improp_nest_constr_norm),
254    File = filename:join(DataDir, improp_nest_constr),
255
256    ok = test_file(File, DataDir),
257    ok.
258
259
260%%--------------------------------------------------------------------
261%% misc
262%%--------------------------------------------------------------------
263%% Misceleaneous checks.
264misc_norm(Config) when is_list(Config) ->
265    DataDir = proplists:get_value(data_dir, Config),
266    _OutDir = ?OUT(misc_norm),
267    File = filename:join(DataDir, misc),
268
269    ok = test_file(File, DataDir),
270    ok.
271
272
273%%--------------------------------------------------------------------
274%% line
275%%--------------------------------------------------------------------
276%% Checks #line.
277line_norm(Config) when is_list(Config) ->
278    DataDir = proplists:get_value(data_dir, Config),
279    _OutDir = ?OUT(line_norm),
280    File = filename:join(DataDir, line),
281
282    ok = test_file(File, DataDir),
283    ok.
284
285
286%%--------------------------------------------------------------------
287%% nopara
288%%--------------------------------------------------------------------
289%% Checks #define with no parameters.
290nopara_norm(Config) when is_list(Config) ->
291    DataDir = proplists:get_value(data_dir, Config),
292    _OutDir = ?OUT(nopara_norm),
293    File = filename:join(DataDir, nopara),
294
295    ok = test_file(File, DataDir),
296    ok.
297
298
299%%--------------------------------------------------------------------
300%% predef
301%%--------------------------------------------------------------------
302%% Checks predefined macros. Note: not __TIME__ and __DATE__.
303predef_norm(Config) when is_list(Config) ->
304    DataDir = proplists:get_value(data_dir, Config),
305    _OutDir = ?OUT(predef_norm),
306    File = filename:join(DataDir, predef),
307
308    ok = test_file(File, DataDir),
309    ok.
310
311
312%%--------------------------------------------------------------------
313%% predef_time
314%%--------------------------------------------------------------------
315%% Checks the predefined macros __TIME__ and __DATE__.
316predef_time_norm(Config) when is_list(Config) ->
317    DataDir = proplists:get_value(data_dir, Config),
318    _OutDir = ?OUT(predef_time_norm),
319    File = filename:join(DataDir, predef_time),
320
321    ok = test_file(File, DataDir),
322    ok.
323
324
325%%--------------------------------------------------------------------
326%% self_ref
327%%--------------------------------------------------------------------
328%% Checks self referring macros.
329self_ref_norm(Config) when is_list(Config) ->
330    DataDir = proplists:get_value(data_dir, Config),
331    _OutDir = ?OUT(self_ref_norm),
332    File = filename:join(DataDir, self_ref),
333
334    ok = test_file(File, DataDir),
335    ok.
336
337
338%%--------------------------------------------------------------------
339%% separate
340%%--------------------------------------------------------------------
341%% Checks separete expansion of macro arguments.
342separate_norm(Config) when is_list(Config) ->
343    DataDir = proplists:get_value(data_dir, Config),
344    _OutDir = ?OUT(separate_norm),
345    File = filename:join(DataDir, separate),
346
347    ok = test_file(File, DataDir),
348    ok.
349
350
351%%--------------------------------------------------------------------
352%% swallow_sc
353%%--------------------------------------------------------------------
354%% Checks swallowing an undesirable semicolon.
355swallow_sc_norm(Config) when is_list(Config) ->
356    DataDir = proplists:get_value(data_dir, Config),
357    _OutDir = ?OUT(swallow_sc_norm),
358    File = filename:join(DataDir, swallow_sc),
359
360    ok = test_file(File, DataDir),
361    ok.
362
363
364%%--------------------------------------------------------------------
365%% unintended_grp
366%%--------------------------------------------------------------------
367%% Checks unintended grouping of arithmetic.
368unintended_grp_norm(Config) when is_list(Config) ->
369    DataDir = proplists:get_value(data_dir, Config),
370    _OutDir = ?OUT(unintended_grp_norm),
371    File = filename:join(DataDir, unintended_grp),
372
373    ok = test_file(File, DataDir),
374    ok.
375
376
377test_file(FileT, DataDir) ->
378    case test_file_1(FileT, DataDir) of
379	ok -> ok;
380	Chars ->
381	    io:put_chars(Chars),
382	    {error,{FileT,DataDir}}
383    end.
384
385test_file_1(FileT, DataDir) ->
386    Tok = string:tokens(FileT, "/"),
387    FileName = lists:last(Tok),
388    File = FileT++".idl",
389
390    test_server:format("File  ~p~n",[File]),
391    test_server:format("FileName  ~p~n",[FileName]),
392
393    Flags = "-I"++DataDir,
394
395    test_server:format("Flags  ~p~n",[Flags]),
396
397    Erl = pp_erl(File, Flags),
398    Gcc = pp_gcc(File, Flags),
399
400    case Erl of
401	{error,_ErlError} ->
402	    test_server:format("Internal_pp Result ~n==================~n~p~n~n",[Erl]);
403	{warning, _ErlWar} ->
404	    test_server:format("Internal_pp Result ~n==================~n~p~n~n",[Erl]);
405	_ ->
406	    test_server:format("Internal_pp Result ~n==================~n~s~n~n",[Erl])
407    end,
408
409    case Gcc of
410	{error,GccError} ->
411	    Error = string:tokens(GccError, "\n"),
412	    test_server:format(?GCC" Result ~n==========~n~p~n~n",
413				     [Error]);
414	_ ->
415	    test_server:format(?GCC" Result ~n==========~n~s~n~n",[Gcc])
416    end,
417
418
419
420    case {Erl,Gcc} of
421	{{warning,W}, {error,X}} ->
422	    case is_ok(W,X) of
423		yes ->
424		    ok;
425		no ->
426		    io_lib:format("Internal_pp found Warning = ~p ~n"
427				  ?GCC" found Error = ~p~n",[W,X])
428	    end;
429
430
431	{{warning,W}, _} ->
432	    io_lib:format(?GCC" did not find warnings while ~n"
433			  "Internal_pp found the following Warning = ~p~n",[W]);
434
435	{{error,E}, {error,X}} ->
436	    case is_ok(E,X) of
437		yes ->
438		    ok;
439		no ->
440		    io_lib:format("Internal_pp found Error = ~p ~n"
441				  ?GCC" found Error = ~p~n",[E,X])
442	    end;
443
444	{{error,E}, _} ->
445	    case FileName of
446		"if" ->
447		    case if_res(E) of
448			ok ->
449			    ok;
450			_ ->
451			    io_lib:format(?GCC" did not find errors while ~n"
452					  "Internal_pp found the following Error = ~p~n",[E])
453		    end;
454		_ ->
455		    io_lib:format(?GCC" did not find errors while ~n"
456				  "Internal_pp found the following Error = ~p~n",[lists:flatten(E)])
457	    end;
458
459	{_, {error,X}} ->
460	    io_lib:format("Internal_pp did not find errors while ~n"
461			  ?GCC" found the following Error = ~p~n",[X]);
462
463	_ ->
464
465	    file:write_file("/tmp/Erl.pp",list_to_binary(Erl)),
466	    file:write_file("/tmp/Gcc.pp",list_to_binary(Gcc)),
467
468	    Res = os:cmd("diff -b -w /tmp/Erl.pp /tmp/Gcc.pp"),
469	    test_server:format("///////////{error,E} E ~p  FileName~p~n",[Res,FileName]),
470	    case {Res, FileName} of
471		{[], _} ->
472		    test_server:format("Diff = []   OK!!!!!!~n"),
473		    ok;
474		{_, "predef_time"} ->
475		    Tokens = string:tokens(Res,"\n"),
476		    test_server:format("///////////{error,E} Tokens~p~n",[Tokens]),
477		    case Tokens of
478			["3c3",_,"---",_,"5c5",_,"---",_,"9c9",_,"---",_] ->
479			    ok;
480			_ ->
481			    io_lib:format("Diff Result = ~p~n",[Res])
482		    end;
483		_ ->
484		    io_lib:format("Diff Result = ~p~n",[Res])
485	    end
486    end.
487
488
489
490
491
492pp_erl(File, Flags) ->
493    case ic_pp:run(File,Flags) of
494	{ok, [$#, $ , $1 | Rest], []} ->
495	    [$#, $ , $1 | Rest];
496	{ok, [$#, $ , $1 | _Rest], Warning} ->
497	    {warning,Warning};
498	{error,Error} ->
499	    {error,Error}
500    end.
501
502pp_gcc(File, Flags) ->
503    Cmd = ?GCC" -x c++ -E",
504    Line	= Cmd++" "++Flags++" "++File,
505
506    case os:cmd(Line) of
507	[$#, $ , $1 | Rest] ->
508	    [$#, $ , $1 | Rest];
509	Res ->
510
511	    case string:str(Res,"# 1 \"") of
512		0 ->
513		    {error,Res};
514		X ->
515		    {error, string:sub_string(Res, 1, X-1)}
516	    end
517    end.
518
519
520is_ok([],_Gcc) ->
521    yes;
522is_ok([{FileName,Line,Text}|T],Gcc) ->
523    Str = FileName++":"++integer_to_list(Line)++": "++Text,
524    case string:str(Gcc,Str) of
525	0 ->
526	    io:format("~n is_ok Internal_pp missed Error = ~s~n",[Str]),
527	    no;
528	_X ->
529	    is_ok(T,Gcc)
530    end;
531is_ok([Str|T],Gcc) ->
532    case string:str(Gcc,Str) of
533	0 ->
534	    io:format("~n is_ok Internal_pp missed Error = ~s~n",[Str]),
535	    no;
536	_X ->
537	    is_ok(T,Gcc)
538    end.
539
540
541to_list(X) when is_atom(X) -> atom_to_list(X);
542to_list(X) -> X.
543
544
545
546if_res(E) ->
547    if_res(E,1).
548
549if_res([H|T],Nr) ->
550    %% Dir = "/clearcase/otp/libraries/ic/test/ic_pp_SUITE_data/if.idl",
551    case {Nr, H} of
552	{1, {_Dir, 2, "only '#if 0' is implemented at present"}} ->
553	    if_res(T,Nr+1);
554	{2, {_Dir, 3, "only '#if 0' is implemented at present"}} ->
555	    if_res(T,Nr+1);
556	{3, {_Dir, 5, "`else' command is not implemented at present"}} ->
557	    if_res(T,Nr+1);
558	{4, {_Dir, 9, "`elif' command is not implemented at present"}} ->
559	    if_res(T,Nr+1);
560	{5, {_Dir, 11, "`else' command is not implemented at present"}} ->
561	    ok;
562	_ ->
563	    error
564    end;
565if_res(_, _) ->
566    error.
567
568
569
570