← Back to branch summary

~ubuntu-branches/ubuntu/trusty/erlang/trusty

« back to all changes in this revision

Viewing changes to lib/common_test/src/ct_framework.erl

  • Committer: Bazaar Package Importer
  • Author(s): Clint Byrum
  • Date: 2011-05-05 15:48:43 UTC
  • mfrom: (3.5.13 sid)
  • Revision ID: james.westby@ubuntu.com-20110505154843-0om6ekzg6m7ugj27
Tags: 1:14.b.2-dfsg-3ubuntu1
* Merge from debian unstable.  Remaining changes:
  - Drop libwxgtk2.8-dev build dependency. Wx isn't in main, and not
    supposed to.
  - Drop erlang-wx binary.
  - Drop erlang-wx dependency from -megaco, -common-test, and -reltool, they
    do not really need wx. Also drop it from -debugger; the GUI needs wx,
    but it apparently has CLI bits as well, and is also needed by -megaco,
    so let's keep the package for now.
  - debian/patches/series: Do what I meant, and enable build-options.patch
    instead.
* Additional changes:
  - Drop erlang-wx from -et
* Dropped Changes:
  - patches/pcre-crash.patch: CVE-2008-2371: outer level option with
    alternatives caused crash. (Applied Upstream)
  - fix for ssl certificate verification in newSSL: 
    ssl_cacertfile_fix.patch (Applied Upstream)
  - debian/patches/series: Enable native.patch again, to get stripped beam
    files and reduce the package size again. (build-options is what
    actually accomplished this)
  - Remove build-options.patch on advice from upstream and because it caused
    odd build failures.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/common_test/src/ct_framework.erl
1
1
%%
2
2
%% %CopyrightBegin%
3
 
%% 
4
 
%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
5
 
%% 
 
3
%%
 
4
%% Copyright Ericsson AB 2004-2011. All Rights Reserved.
 
5
%%
6
6
%% The contents of this file are subject to the Erlang Public License,
7
7
%% Version 1.1, (the "License"); you may not use this file except in
8
8
%% compliance with the License. You should have received a copy of the
9
9
%% Erlang Public License along with this software. If not, it can be
10
10
%% retrieved online at http://www.erlang.org/.
11
 
%% 
 
11
%%
12
12
%% Software distributed under the License is distributed on an "AS IS"
13
13
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
14
14
%% the License for the specific language governing rights and limitations
15
15
%% under the License.
16
 
%% 
 
16
%%
17
17
%% %CopyrightEnd%
18
18
%%
19
19
 
24
24
 
25
25
-module(ct_framework).
26
26
 
27
 
-export([init_tc/3, end_tc/3, get_suite/2, report/2, warn/1]).
 
27
-export([init_tc/3, end_tc/4, get_suite/2, report/2, warn/1]).
28
28
-export([error_notification/4]).
29
29
 
30
 
-export([error_in_suite/1]).
 
30
-export([overview_html_header/1]).
 
31
 
 
32
-export([error_in_suite/1, ct_init_per_group/2, ct_end_per_group/2]).
 
33
 
 
34
-export([make_all_conf/3, make_conf/5]).
31
35
 
32
36
-include("ct_event.hrl").
33
37
-include("ct_util.hrl").
101
105
                [{saved_config,{LastFunc,SavedConfig}} | 
102
106
                 lists:keydelete(saved_config,1,Config0)];
103
107
            {{LastSuite,InitOrEnd},SavedConfig} when InitOrEnd == init_per_suite ;
104
 
                                                     InitOrEnd == end_per_suite -> % last suite
 
108
                                                     InitOrEnd == end_per_suite ->
 
109
                %% last suite
105
110
                [{saved_config,{LastSuite,SavedConfig}} | 
106
111
                 lists:keydelete(saved_config,1,Config0)];
107
112
            undefined ->
113
118
            ok;
114
119
        true ->
115
120
            %% delete all default values used in previous suite
116
 
            ct_util:delete_default_config(suite),
 
121
            ct_config:delete_default_config(suite),
117
122
            %% release all name -> key bindings (once per suite)
118
 
            ct_util:release_allocated()
 
123
            ct_config:release_allocated()
119
124
    end,
120
125
    TestCaseInfo =
121
126
        case catch apply(Mod,Func,[]) of
125
130
    %% clear all config data default values set by previous
126
131
    %% testcase info function (these should only survive the
127
132
    %% testcase, not the whole suite)
128
 
    ct_util:delete_default_config(testcase),
 
133
    ct_config:delete_default_config(testcase),
129
134
    case add_defaults(Mod,Func,TestCaseInfo,DoInit) of
130
135
        Error = {suite0_failed,_} ->
131
136
            ct_logs:init_tc(),
161
166
            _ ->
162
167
                MergeResult
163
168
        end,
 
169
 
164
170
    %% timetrap must be handled before require
165
171
    MergedInfo1 = timetrap_first(MergedInfo, [], []),
166
172
    %% tell logger to use specified style sheet
201
207
            {skip,{require_failed_in_suite0,Reason}};
202
208
        {error,Reason} ->
203
209
            {auto_skip,{require_failed,Reason}};
204
 
        FinalConfig ->
 
210
        {ok, FinalConfig} ->
205
211
            case MergeResult of
206
212
                {error,Reason} ->
207
213
                    %% suite0 configure finished now, report that 
210
216
                _ ->
211
217
                    case get('$test_server_framework_test') of
212
218
                        undefined ->
213
 
                            FinalConfig;
 
219
                            ct_suite_init(Mod, FuncSpec, FinalConfig);
214
220
                        Fun ->
215
 
                            Fun(init_tc, FinalConfig)
 
221
                            case Fun(init_tc, FinalConfig) of
 
222
                                NewConfig when is_list(NewConfig) ->
 
223
                                    {ok,NewConfig};
 
224
                                Else ->
 
225
                                    Else
 
226
                            end
216
227
                    end
217
228
            end
218
229
    end.
219
 
            
 
230
 
 
231
ct_suite_init(Mod, Func, [Config]) when is_list(Config) ->
 
232
    case ct_hooks:init_tc( Mod, Func, Config) of
 
233
        NewConfig when is_list(NewConfig) ->
 
234
            {ok, [NewConfig]};
 
235
        Else ->
 
236
            Else
 
237
    end.
220
238
 
221
239
add_defaults(Mod,Func,FuncInfo,DoInit) ->
222
240
    case (catch Mod:suite()) of
233
251
                              (_) -> false
234
252
                           end, SuiteInfo) of
235
253
                true ->
236
 
                    SuiteInfo1 = merge_with_suite_defaults(Mod,SuiteInfo),
 
254
                    SuiteInfoNoCTH = 
 
255
                        lists:keydelete(ct_hooks,1,SuiteInfo),
 
256
                    SuiteInfo1 = merge_with_suite_defaults(Mod,SuiteInfoNoCTH),
237
257
                    case add_defaults1(Mod,Func,FuncInfo,SuiteInfo1,DoInit) of
238
258
                        Error = {error,_} -> {SuiteInfo1,Error};
239
259
                        MergedInfo -> {SuiteInfo1,MergedInfo}
244
264
        _ ->
245
265
            {suite0_failed,bad_return_value}
246
266
    end.
247
 
    
248
 
add_defaults1(_Mod,init_per_suite,[],SuiteInfo,_) ->
 
267
 
 
268
add_defaults1(_Mod,init_per_suite,[],SuiteInfo,_DoInit) ->
249
269
    SuiteInfo;
250
270
 
251
271
add_defaults1(Mod,Func,FuncInfo,SuiteInfo,DoInit) ->
253
273
    %% can result in weird behaviour (suite values get overwritten)
254
274
    SuiteReqs = 
255
275
        [SDDef || SDDef <- SuiteInfo,
256
 
                  require == element(1,SDDef)],
257
 
    case [element(2,Clash) || Clash <- SuiteReqs, 
258
 
          true == lists:keymember(element(2,Clash),2,FuncInfo)] of
 
276
                  ((require == element(1,SDDef)) or
 
277
                   (default_config == element(1,SDDef)))],
 
278
    FuncReqs =
 
279
        [FIDef || FIDef <- FuncInfo,
 
280
                  require == element(1,FIDef)],
 
281
    case [element(2,Clash) || Clash <- SuiteReqs,
 
282
                              require == element(1, Clash),
 
283
                              true == lists:keymember(element(2,Clash),2,
 
284
                                                      FuncReqs)] of
259
285
        [] ->
260
286
            add_defaults2(Mod,Func,FuncInfo,SuiteInfo,SuiteReqs,DoInit);
261
287
        Clashes ->
262
288
            {error,{config_name_already_in_use,Clashes}}
263
289
    end.
264
290
 
 
291
add_defaults2(Mod,init_per_suite,IPSInfo,SuiteInfo,SuiteReqs,false) ->
 
292
    %% not common practise to use a test case info function for
 
293
    %% init_per_suite (usually handled by suite/0), but let's support
 
294
    %% it just in case...
 
295
    add_defaults2(Mod,init_per_suite,IPSInfo,SuiteInfo,SuiteReqs,true);
 
296
 
265
297
add_defaults2(_Mod,_Func,FuncInfo,SuiteInfo,_,false) ->
266
298
    %% include require elements from test case info, but not from suite/0
267
299
    %% (since we've already required those vars)
344
376
configure([{timetrap,Time}|Rest],Info,SuiteInfo,Scope,Config) ->
345
377
    Dog = test_server:timetrap(Time),
346
378
    configure(Rest,Info,SuiteInfo,Scope,[{watchdog,Dog}|Config]);
 
379
configure([{ct_hooks, Hook} | Rest], Info, SuiteInfo, Scope, Config) ->
 
380
    configure(Rest, Info, SuiteInfo, Scope, [{ct_hooks, Hook} | Config]);
347
381
configure([_|Rest],Info,SuiteInfo,Scope,Config) ->
348
382
    configure(Rest,Info,SuiteInfo,Scope,Config);
349
383
configure([],_,_,_,Config) ->
381
415
        {_,[]} -> 
382
416
            no_default;
383
417
        {'_UNDEF',_} ->
384
 
            [ct_util:set_default_config([CfgVal],Where) || CfgVal <- CfgElems],
 
418
            [ct_config:set_default_config([CfgVal],Where) || CfgVal <- CfgElems],
385
419
            ok;
386
420
        _ ->
387
 
            [ct_util:set_default_config(Name,[CfgVal],Where) || CfgVal <- CfgElems],
 
421
            [ct_config:set_default_config(Name,[CfgVal],Where) || CfgVal <- CfgElems],
388
422
            ok
389
423
    end.
390
424
            
400
434
%%%
401
435
%%% @doc Test server framework callback, called by the test_server
402
436
%%% when a test case is finished.
403
 
end_tc(?MODULE,error_in_suite,_) ->             % bad start!
 
437
end_tc(?MODULE,error_in_suite,_, _) ->          % bad start!
404
438
    ok;
405
 
end_tc(Mod,Func,{TCPid,Result,[Args]}) when is_pid(TCPid) ->
406
 
    end_tc(Mod,Func,TCPid,Result,Args);
407
 
end_tc(Mod,Func,{Result,[Args]}) ->
408
 
    end_tc(Mod,Func,self(),Result,Args).
 
439
end_tc(Mod,Func,{TCPid,Result,[Args]}, Return) when is_pid(TCPid) ->
 
440
    end_tc(Mod,Func,TCPid,Result,Args,Return);
 
441
end_tc(Mod,Func,{Result,[Args]}, Return) ->
 
442
    end_tc(Mod,Func,self(),Result,Args,Return).
409
443
 
410
 
end_tc(Mod,Func,TCPid,Result,Args) ->
 
444
end_tc(Mod,Func,TCPid,Result,Args,Return) ->
411
445
    case lists:keysearch(watchdog,1,Args) of
412
446
        {value,{watchdog,Dog}} -> test_server:timetrap_cancel(Dog);
413
447
        false -> ok
430
464
            {_,GroupName,_Props} = Group ->                            
431
465
                case lists:keysearch(save_config,1,Args) of
432
466
                    {value,{save_config,SaveConfig}} ->
433
 
                        ct_util:save_suite_data(last_saved_config,
434
 
                                                {Mod,{group,GroupName}},SaveConfig),
 
467
                        ct_util:save_suite_data(
 
468
                          last_saved_config,
 
469
                          {Mod,{group,GroupName}},
 
470
                          SaveConfig),
435
471
                        Group;
436
472
                    false ->
437
473
                        Group
448
484
        end,
449
485
    ct_util:reset_silent_connections(),
450
486
 
451
 
    %% send sync notification so that event handlers may print
452
 
    %% in the log file before it gets closed
453
 
    ct_event:sync_notify(#event{name=tc_done,
454
 
                                node=node(),
455
 
                                data={Mod,FuncSpec,tag(Result)}}),
456
 
    case Result of
 
487
    case get('$test_server_framework_test') of
 
488
        undefined ->
 
489
            {FinalResult,FinalNotify} =
 
490
                case ct_hooks:end_tc(
 
491
                            Mod, FuncSpec, Args, Result, Return) of
 
492
                    '$ct_no_change' ->
 
493
                        {FinalResult = ok,Result};
 
494
                    FinalResult ->
 
495
                        {FinalResult,FinalResult}
 
496
                end,
 
497
            % send sync notification so that event handlers may print
 
498
            % in the log file before it gets closed
 
499
            ct_event:sync_notify(#event{name=tc_done,
 
500
                                        node=node(),
 
501
                                        data={Mod,FuncSpec,
 
502
                                              tag_cth(FinalNotify)}});
 
503
        Fun ->
 
504
            % send sync notification so that event handlers may print
 
505
            % in the log file before it gets closed
 
506
            ct_event:sync_notify(#event{name=tc_done,
 
507
                                        node=node(),
 
508
                                        data={Mod,FuncSpec,tag(Result)}}),
 
509
            FinalResult = Fun(end_tc, Return)
 
510
    end,
 
511
 
 
512
    
 
513
    case FinalResult of
457
514
        {skip,{sequence_failed,_,_}} ->
458
515
            %% ct_logs:init_tc is never called for a skipped test case
459
516
            %% in a failing sequence, so neither should end_tc      
472
529
        _ -> 
473
530
            ok
474
531
    end,
475
 
    case get('$test_server_framework_test') of
476
 
        undefined ->
477
 
            ok;
478
 
        Fun ->
479
 
            Fun(end_tc, ok)
480
 
    end.
 
532
    FinalResult.            
481
533
 
482
534
%% {error,Reason} | {skip,Reason} | {timetrap_timeout,TVal} | 
483
535
%% {testcase_aborted,Reason} | testcase_aborted_or_killed | 
493
545
tag(Other) ->
494
546
    Other.
495
547
 
 
548
tag_cth({STag,Reason}) when STag == skip; STag == skipped -> 
 
549
    {skipped,Reason};
 
550
tag_cth({fail, Reason}) ->
 
551
    {failed, {error,Reason}};
 
552
tag_cth(E = {ETag,_}) when ETag == error; ETag == 'EXIT'; 
 
553
                       ETag == timetrap_timeout;
 
554
                       ETag == testcase_aborted -> 
 
555
    {failed,E};
 
556
tag_cth(E = testcase_aborted_or_killed) ->
 
557
    {failed,E};
 
558
tag_cth(List) when is_list(List) ->
 
559
    ok;
 
560
tag_cth(Other) ->
 
561
    Other.
 
562
 
496
563
%%%-----------------------------------------------------------------
497
564
%%% @spec error_notification(Mod,Func,Args,Error) -> ok
498
565
%%%      Mod = atom()
631
698
%%%      and every test case. If the former, all test cases in the suite
632
699
%%%      should be returned. 
633
700
 
634
 
get_suite(Mod, all) ->    
 
701
get_suite(Mod, all) ->
635
702
    case catch apply(Mod, groups, []) of
636
703
        {'EXIT',_} ->
637
704
            get_all(Mod, []);
638
705
        GroupDefs when is_list(GroupDefs) ->
639
 
            case catch check_groups(Mod, GroupDefs) of
 
706
            case catch find_groups(Mod, all, all, GroupDefs) of
640
707
                {error,_} = Error ->
641
708
                    %% this makes test_server call error_in_suite as first
642
709
                    %% (and only) test case so we can report Error properly
651
718
 
652
719
%%!============================================================
653
720
%%! Note: The handling of sequences in get_suite/2 and get_all/2
654
 
%%! is deprecated and should be removed after OTP R13!
 
721
%%! is deprecated and should be removed at some point...
655
722
%%!============================================================
656
723
 
 
724
%% group
 
725
get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) ->
 
726
    Name = proplists:get_value(name, Props),
 
727
    case catch apply(Mod, groups, []) of
 
728
        {'EXIT',_} ->
 
729
            [Group];
 
730
        GroupDefs when is_list(GroupDefs) ->
 
731
            case catch find_groups(Mod, Name, TCs, GroupDefs) of
 
732
                {error,_} = Error ->
 
733
                    %% this makes test_server call error_in_suite as first
 
734
                    %% (and only) test case so we can report Error properly
 
735
                    [{?MODULE,error_in_suite,[[Error]]}];
 
736
                [] ->
 
737
                    {error,{invalid_group_spec,Name}};
 
738
                ConfTests ->
 
739
                    case lists:member(skipped, Props) of
 
740
                        true ->
 
741
                            %% a *subgroup* specified *only* as skipped (and not
 
742
                            %% as an explicit test) should not be returned, or
 
743
                            %% init/end functions for top groups will be executed
 
744
                            case catch proplists:get_value(name, element(2, hd(ConfTests))) of
 
745
                                Name ->         % top group
 
746
                                    delete_subs(ConfTests, ConfTests);
 
747
                                _ ->
 
748
                                    []
 
749
                            end;
 
750
                        false ->
 
751
                            delete_subs(ConfTests, ConfTests)
 
752
                    end
 
753
            end;
 
754
        _ ->
 
755
            E = "Bad return value from "++atom_to_list(Mod)++":groups/0",
 
756
            [{?MODULE,error_in_suite,[[{error,list_to_atom(E)}]]}]
 
757
    end;
 
758
 
 
759
%% testcase
657
760
get_suite(Mod, Name) ->
658
 
    %% Name may be name of a group or a test case. If it's a group,
659
 
    %% it should be expanded to list of cases (in a conf term)
660
 
    case catch apply(Mod, groups, []) of
661
 
        {'EXIT',_} ->
662
 
            get_seq(Mod, Name);
663
 
        GroupDefs when is_list(GroupDefs) ->
664
 
            case catch check_groups(Mod, GroupDefs) of
665
 
                {error,_} = Error ->
666
 
                    %% this makes test_server call error_in_suite as first
667
 
                    %% (and only) test case so we can report Error properly
668
 
                    [{?MODULE,error_in_suite,[[Error]]}];
669
 
                ConfTests ->
670
 
                    FindConf = fun({conf,Props,_,_,_}) ->
671
 
                                       case proplists:get_value(name, Props) of
672
 
                                           Name -> true;
673
 
                                           _    -> false
674
 
                                       end
675
 
                               end,                                      
676
 
                    case lists:filter(FindConf, ConfTests) of
677
 
                        [] ->                   % must be a test case
678
 
                            get_seq(Mod, Name);
679
 
                        [ConfTest|_] ->
680
 
                            ConfTest
681
 
                    end
682
 
            end;
 
761
     get_seq(Mod, Name).
 
762
 
 
763
%%%-----------------------------------------------------------------
 
764
 
 
765
find_groups(Mod, Name, TCs, GroupDefs) ->
 
766
    Found = find(Mod, Name, TCs, GroupDefs, [], GroupDefs, false),
 
767
    Trimmed = trim(Found),
 
768
    %% I cannot find a reason to why this function is called,
 
769
    %% It deletes any group which is referenced in any other
 
770
    %% group. i.e.
 
771
    %% groups() ->
 
772
    %%   [{test, [], [testcase1]},
 
773
    %%    {testcases, [], [{group, test}]}].
 
774
    %% Would be changed to
 
775
    %% groups() ->
 
776
    %%   [{testcases, [], [testcase1]}].
 
777
    %% instead of what I believe is correct:
 
778
    %% groups() ->
 
779
    %%   [{test, [], [testcase1]},
 
780
    %%    {testcases, [], [testcase1]}].
 
781
    %% Have to double check with peppe
 
782
    delete_subs(Trimmed, Trimmed),
 
783
    Trimmed.
 
784
 
 
785
find(Mod, all, _TCs, [{Name,Props,Tests} | Gs], Known, Defs, _) 
 
786
  when is_atom(Name), is_list(Props), is_list(Tests) ->
 
787
    cyclic_test(Mod, Name, Known),
 
788
    [make_conf(Mod, Name, Props,
 
789
               find(Mod, all, all, Tests, [Name | Known], Defs, true)) |
 
790
     find(Mod, all, all, Gs, [], Defs, true)];
 
791
 
 
792
find(Mod, Name, TCs, [{Name,Props,Tests} | _Gs], Known, Defs, false)
 
793
  when is_atom(Name), is_list(Props), is_list(Tests) ->
 
794
    cyclic_test(Mod, Name, Known),
 
795
    case TCs of
 
796
        all ->
 
797
            [make_conf(Mod, Name, Props,
 
798
                       find(Mod, Name, TCs, Tests, [Name | Known], Defs, true))];
683
799
        _ ->
684
 
            E = "Bad return value from "++atom_to_list(Mod)++":groups/0",
685
 
            [{?MODULE,error_in_suite,[[{error,list_to_atom(E)}]]}]
686
 
    end.
687
 
 
688
 
check_groups(_Mod, []) ->
689
 
    [];
690
 
check_groups(Mod, Defs) ->
691
 
    check_groups(Mod, Defs, Defs, []).
692
 
 
693
 
check_groups(Mod, [TC | Gs], Defs, Levels) when is_atom(TC), length(Levels)>0 ->
694
 
    [TC | check_groups(Mod, Gs, Defs, Levels)];
695
 
 
696
 
check_groups(Mod, [{group,SubName} | Gs], Defs, Levels) when is_atom(SubName) ->
697
 
    case lists:member(SubName, Levels) of
698
 
        true ->
699
 
            E = "Cyclic reference to group "++atom_to_list(SubName)++
700
 
                " in "++atom_to_list(Mod)++":groups/0",
701
 
            throw({error,list_to_atom(E)});
702
 
        false ->            
703
 
            case find_group(Mod, SubName, Defs) of
704
 
                {error,_} = Error ->
705
 
                    throw(Error);
706
 
                G ->
707
 
                    [check_groups(Mod, [G], Defs, Levels) | 
708
 
                     check_groups(Mod, Gs, Defs, Levels)]
709
 
            end
 
800
            Tests1 = [TC || TC <- TCs,
 
801
                            lists:member(TC, Tests) == true],
 
802
            [make_conf(Mod, Name, Props, Tests1)]
710
803
    end;
711
804
 
712
 
check_groups(Mod, [{Name,Tests} | Gs], Defs, Levels) when is_atom(Name),
713
 
                                                          is_list(Tests) ->
714
 
    check_groups(Mod, [{Name,[],Tests} | Gs], Defs, Levels);
715
 
 
716
 
check_groups(Mod, [{Name,Props,Tests} | Gs], Defs, Levels) when is_atom(Name),
717
 
                                                                is_list(Props),
718
 
                                                                is_list(Tests) ->
719
 
    {TestSpec,Levels1} = 
720
 
        case Levels of
721
 
            [] ->
722
 
                {check_groups(Mod, Tests, Defs, [Name]),[]};
723
 
            _ ->
724
 
                {check_groups(Mod, Tests, Defs, [Name|Levels]),Levels}
725
 
        end,
726
 
    [make_conf(Mod, Name, Props, TestSpec) | 
727
 
     check_groups(Mod, Gs, Defs, Levels1)];
728
 
 
729
 
check_groups(Mod, [BadTerm | _Gs], _Defs, Levels) ->
730
 
    Where = if length(Levels) == 0 ->
 
805
find(Mod, Name, TCs, [{Name1,Props,Tests} | Gs], Known, Defs, false)
 
806
  when is_atom(Name1), is_list(Props), is_list(Tests) ->
 
807
    cyclic_test(Mod, Name1, Known),
 
808
    [make_conf(Mod,Name1,Props,
 
809
                   find(Mod, Name, TCs, Tests, [Name1 | Known], Defs, false)) |
 
810
     find(Mod, Name, TCs, Gs, [], Defs, false)];
 
811
 
 
812
find(Mod, Name, _TCs, [{Name,_Props,_Tests} | _Gs], _Known, _Defs, true)
 
813
  when is_atom(Name) ->
 
814
    E = "Duplicate groups named "++atom_to_list(Name)++" in "++
 
815
        atom_to_list(Mod)++":groups/0",
 
816
    throw({error,list_to_atom(E)});
 
817
 
 
818
find(Mod, Name, all, [{Name1,Props,Tests} | Gs], Known, Defs, true)
 
819
  when is_atom(Name1), is_list(Props), is_list(Tests) ->
 
820
    cyclic_test(Mod, Name1, Known),
 
821
    [make_conf(Mod, Name1, Props,
 
822
               find(Mod, Name, all, Tests, [Name1 | Known], Defs, true)) |
 
823
     find(Mod, Name, all, Gs, [], Defs, true)];
 
824
 
 
825
find(Mod, Name, TCs, [{group,Name1} | Gs], Known, Defs, Found) 
 
826
  when is_atom(Name1) ->
 
827
    find(Mod, Name, TCs, [expand(Mod, Name1, Defs) | Gs], Known, Defs, Found);
 
828
 
 
829
%% Undocumented remote group feature, use with caution
 
830
find(Mod, Name, TCs, [{group, ExtMod, ExtGrp} | Gs], Known, Defs, true)
 
831
  when is_atom(ExtMod), is_atom(ExtGrp) ->
 
832
    ExternalDefs = ExtMod:groups(),
 
833
    ExternalTCs = find(ExtMod, ExtGrp, TCs, [{group, ExtGrp}],
 
834
                       [], ExternalDefs, false),
 
835
     ExternalTCs ++ find(Mod, Name, TCs, Gs, Known, Defs, true);
 
836
 
 
837
find(Mod, Name, TCs, [{Name1,Tests} | Gs], Known, Defs, Found)
 
838
  when is_atom(Name1), is_list(Tests) ->
 
839
    find(Mod, Name, TCs, [{Name1,[],Tests} | Gs], Known, Defs, Found);
 
840
 
 
841
find(Mod, Name, TCs, [_TC | Gs], Known, Defs, false) ->
 
842
    find(Mod, Name, TCs, Gs, Known, Defs, false);
 
843
 
 
844
find(Mod, Name, TCs, [TC | Gs], Known, Defs, true) when is_atom(TC) ->
 
845
    [{Mod, TC} | find(Mod, Name, TCs, Gs, Known, Defs, true)];
 
846
 
 
847
find(Mod, Name, TCs, [{ExternalTC, Case} = TC | Gs], Known, Defs, true)
 
848
  when is_atom(ExternalTC),
 
849
       is_atom(Case) ->
 
850
    [TC | find(Mod, Name, TCs, Gs, Known, Defs, true)];
 
851
 
 
852
find(Mod, _Name, _TCs, [BadTerm | _Gs], Known, _Defs, _Found) ->
 
853
    Where = if length(Known) == 0 ->
731
854
                    atom_to_list(Mod)++":groups/0";
732
855
               true ->
733
 
                    "group "++atom_to_list(lists:last(Levels))++
 
856
                    "group "++atom_to_list(lists:last(Known))++
734
857
                        " in "++atom_to_list(Mod)++":groups/0"
735
858
            end,                 
736
859
    Term = io_lib:format("~p", [BadTerm]),
737
860
    E = "Bad term "++lists:flatten(Term)++" in "++Where,
738
861
    throw({error,list_to_atom(E)});
739
862
 
740
 
check_groups(_Mod, [], _Defs, _) ->
741
 
    [].
742
 
 
743
 
find_group(Mod, Name, Defs) ->
 
863
find(_Mod, _Name, _TCs,  [], _Known, _Defs, false) ->
 
864
    ['$NOMATCH'];
 
865
 
 
866
find(_Mod, _Name, _TCs,  [], _Known, _Defs, _Found) ->
 
867
    [].
 
868
 
 
869
delete_subs([{conf, _,_,_,_} = Conf | Confs], All) ->
 
870
    All1 = delete_conf(Conf, All),
 
871
    case is_sub(Conf, All1) of
 
872
        true ->
 
873
            delete_subs(Confs, All1);
 
874
        false ->
 
875
            delete_subs(Confs, All)
 
876
    end;
 
877
delete_subs([_Else | Confs], All) ->
 
878
    delete_subs(Confs, All);
 
879
delete_subs([], All) ->
 
880
    All.
 
881
 
 
882
delete_conf({conf,Props,_,_,_}, Confs) ->
 
883
    Name = proplists:get_value(name, Props),
 
884
    [Conf || Conf = {conf,Props0,_,_,_} <- Confs,
 
885
             Name =/= proplists:get_value(name, Props0)].
 
886
 
 
887
is_sub({conf,Props,_,_,_}=Conf, [{conf,_,_,Tests,_} | Confs]) ->
 
888
    Name = proplists:get_value(name, Props),
 
889
    case lists:any(fun({conf,Props0,_,_,_}) ->
 
890
                           case proplists:get_value(name, Props0) of
 
891
                               N when N == Name ->
 
892
                                   true;
 
893
                               _ ->
 
894
                                   false
 
895
                           end;
 
896
                      (_) ->
 
897
                           false
 
898
                   end, Tests) of
 
899
        true ->
 
900
            true;
 
901
        false ->
 
902
            is_sub(Conf, Tests) or is_sub(Conf, Confs)
 
903
    end;
 
904
 
 
905
is_sub(Conf, [_TC | Tests]) ->
 
906
    is_sub(Conf, Tests);
 
907
 
 
908
is_sub(_Conf, []) ->
 
909
    false.
 
910
 
 
911
trim(['$NOMATCH' | Tests]) ->
 
912
    trim(Tests);
 
913
 
 
914
trim([{conf,Props,Init,Tests,End} | Confs]) ->
 
915
    case trim(Tests) of
 
916
        [] ->
 
917
            trim(Confs);
 
918
        Trimmed ->
 
919
            [{conf,Props,Init,Trimmed,End} | trim(Confs)]
 
920
    end;
 
921
 
 
922
trim([TC | Tests]) ->
 
923
    [TC | trim(Tests)];
 
924
 
 
925
trim([]) ->
 
926
    [].
 
927
 
 
928
cyclic_test(Mod, Name, Names) ->
 
929
    case lists:member(Name, Names) of
 
930
        true ->
 
931
            E = "Cyclic reference to group "++atom_to_list(Name)++
 
932
                " in "++atom_to_list(Mod)++":groups/0",
 
933
            throw({error,list_to_atom(E)});
 
934
        false ->
 
935
            ok
 
936
    end.
 
937
 
 
938
expand(Mod, Name, Defs) ->
744
939
    case lists:keysearch(Name, 1, Defs) of
745
940
        {value,Def} -> 
746
941
            Def;
750
945
            throw({error,list_to_atom(E)})
751
946
    end.
752
947
 
 
948
make_all_conf(Dir, Mod, _Props) ->
 
949
    case code:is_loaded(Mod) of
 
950
        false ->
 
951
            code:load_abs(filename:join(Dir,atom_to_list(Mod)));
 
952
        _ ->
 
953
            ok
 
954
    end,
 
955
    make_all_conf(Mod).
 
956
 
 
957
make_all_conf(Mod) ->
 
958
    case catch apply(Mod, groups, []) of
 
959
        {'EXIT',_} ->
 
960
            {error,{invalid_group_definition,Mod}};
 
961
        GroupDefs when is_list(GroupDefs) ->
 
962
            case catch find_groups(Mod, all, all, GroupDefs) of
 
963
                {error,_} = Error ->
 
964
                    %% this makes test_server call error_in_suite as first
 
965
                    %% (and only) test case so we can report Error properly
 
966
                    [{?MODULE,error_in_suite,[[Error]]}];
 
967
                [] ->
 
968
                    {error,{invalid_group_spec,Mod}};
 
969
                ConfTests ->
 
970
                    [{conf,Props,Init,all,End} ||
 
971
                        {conf,Props,Init,_,End}
 
972
                            <- delete_subs(ConfTests, ConfTests)]
 
973
            end
 
974
    end.
 
975
 
 
976
make_conf(Dir, Mod, Name, Props, TestSpec) ->
 
977
    case code:is_loaded(Mod) of
 
978
        false ->
 
979
            code:load_abs(filename:join(Dir,atom_to_list(Mod)));
 
980
        _ ->
 
981
            ok
 
982
    end,
 
983
    make_conf(Mod, Name, Props, TestSpec).
 
984
 
753
985
make_conf(Mod, Name, Props, TestSpec) ->
754
 
    {conf,[{name,Name}|Props],
755
 
     {Mod,init_per_group},TestSpec,{Mod,end_per_group}}.
 
986
    case code:is_loaded(Mod) of
 
987
        false ->
 
988
            code:load_file(Mod);
 
989
        _ ->
 
990
            ok
 
991
    end,
 
992
    {InitConf,EndConf} =
 
993
        case erlang:function_exported(Mod,init_per_group,2) of
 
994
            true ->
 
995
                {{Mod,init_per_group},{Mod,end_per_group}};
 
996
            false ->
 
997
                {{?MODULE,ct_init_per_group},
 
998
                 {?MODULE,ct_end_per_group}}
 
999
        end,
 
1000
    {conf,[{name,Name}|Props],InitConf,TestSpec,EndConf}.
756
1001
 
 
1002
%%%-----------------------------------------------------------------
757
1003
 
758
1004
get_all(Mod, ConfTests) ->      
759
1005
    case catch apply(Mod, all, []) of
769
1015
                    [{?MODULE,error_in_suite,[[{error,What}]]}];
770
1016
                SeqsAndTCs ->
771
1017
                    %% expand group references in all() using ConfTests
772
 
                    Expand =
773
 
                        fun({group,Name}) ->
774
 
                                FindConf = 
775
 
                                    fun({conf,Props,_,_,_}) ->
776
 
                                            case proplists:get_value(name, Props) of
777
 
                                                Name -> true;
778
 
                                                _    -> false
779
 
                                            end
780
 
                                           end,                                  
781
 
                                case lists:filter(FindConf, ConfTests) of
782
 
                                    [ConfTest|_] ->
783
 
                                        ConfTest;
784
 
                                    [] ->
785
 
                                        E = "Invalid reference to group "++
786
 
                                            atom_to_list(Name)++" in "++
787
 
                                            atom_to_list(Mod)++":all/0",
788
 
                                        throw({error,list_to_atom(E)})
789
 
                                end;
790
 
                           (SeqOrTC) -> SeqOrTC
791
 
                        end,
792
 
                    case catch lists:map(Expand, SeqsAndTCs) of
 
1018
                    case catch expand_groups(SeqsAndTCs, ConfTests, Mod) of
793
1019
                        {error,_} = Error ->
794
1020
                            [{?MODULE,error_in_suite,[[Error]]}];
795
1021
                        Tests ->
796
 
                            Tests
 
1022
                            delete_subs(Tests, Tests)
797
1023
                    end
798
1024
            end;
799
1025
        Skip = {skip,_Reason} ->
804
1030
            [{?MODULE,error_in_suite,[[{error,Reason}]]}]
805
1031
    end.
806
1032
 
 
1033
expand_groups([H | T], ConfTests, Mod) ->
 
1034
    [expand_groups(H, ConfTests, Mod) | expand_groups(T, ConfTests, Mod)];
 
1035
expand_groups([], _ConfTests, _Mod) ->
 
1036
    [];
 
1037
expand_groups({group,Name}, ConfTests, Mod) ->
 
1038
    FindConf = 
 
1039
        fun({conf,Props,_,_,_}) ->
 
1040
                case proplists:get_value(name, Props) of
 
1041
                    Name -> true;
 
1042
                    _    -> false
 
1043
                end
 
1044
        end,                                     
 
1045
    case lists:filter(FindConf, ConfTests) of
 
1046
        [ConfTest|_] ->
 
1047
            expand_groups(ConfTest, ConfTests, Mod);
 
1048
        [] ->
 
1049
            E = "Invalid reference to group "++
 
1050
                atom_to_list(Name)++" in "++
 
1051
                atom_to_list(Mod)++":all/0",
 
1052
            throw({error,list_to_atom(E)})
 
1053
    end;
 
1054
expand_groups(SeqOrTC, _ConfTests, _Mod) ->
 
1055
    SeqOrTC.
 
1056
 
807
1057
 
808
1058
%%!============================================================
809
1059
%%! The support for sequences by means of using sequences/0
916
1166
error_in_suite(Config) ->
917
1167
    Reason = test_server:lookup_config(error,Config),
918
1168
    exit(Reason).
 
1169
 
 
1170
%% if the group config functions are missing in the suite,
 
1171
%% use these instead
 
1172
ct_init_per_group(GroupName, Config) ->
 
1173
    ct_logs:log("WARNING", "init_per_group/2 for ~w missing in suite, using default.", 
 
1174
                [GroupName]),
 
1175
    Config.
 
1176
 
 
1177
ct_end_per_group(GroupName, _) ->
 
1178
    ct_logs:log("WARNING", "end_per_group/2 for ~w missing in suite, using default.", 
 
1179
                [GroupName]),
 
1180
    ok.
 
1181
 
919
1182
    
920
1183
%%%-----------------------------------------------------------------
921
1184
%%% @spec report(What,Data) -> ok
960
1223
            ok;
961
1224
        tc_done ->
962
1225
            {_Suite,Case,Result} = Data,
 
1226
            case Result of
 
1227
                {failed, _} ->
 
1228
                    ct_hooks:on_tc_fail(What, Data);
 
1229
                {skipped,{failed,{_,init_per_testcase,_}}} ->
 
1230
                    ct_hooks:on_tc_skip(tc_auto_skip, Data);
 
1231
                {skipped,{require_failed,_}} ->
 
1232
                    ct_hooks:on_tc_skip(tc_auto_skip, Data);
 
1233
                {skipped,_} ->
 
1234
                    ct_hooks:on_tc_skip(tc_user_skip, Data);
 
1235
                _Else ->
 
1236
                    ok
 
1237
            end,
963
1238
            case {Case,Result} of
964
1239
                {init_per_suite,_} ->
965
1240
                    ok;
977
1252
                    add_to_stats(auto_skipped);
978
1253
                {_,{skipped,_}} ->
979
1254
                    add_to_stats(user_skipped);
980
 
                {_,{FailOrSkip,_Reason}} ->
981
 
                    add_to_stats(FailOrSkip)
 
1255
                {_,{SkipOrFail,_Reason}} ->
 
1256
                    add_to_stats(SkipOrFail)
982
1257
            end;
983
1258
        tc_user_skip ->     
984
1259
            %% test case specified as skipped in testspec
986
1261
            ct_event:sync_notify(#event{name=tc_user_skip,
987
1262
                                        node=node(),
988
1263
                                        data=Data}),
 
1264
            ct_hooks:on_tc_skip(What, Data),
989
1265
            add_to_stats(user_skipped);
990
1266
        tc_auto_skip ->
991
1267
            %% test case skipped because of error in init_per_suite
998
1274
            ct_event:sync_notify(#event{name=tc_auto_skip,
999
1275
                                        node=node(),
1000
1276
                                        data=Data}),
 
1277
            ct_hooks:on_tc_skip(What, Data),
1001
1278
            if Case /= end_per_suite, Case /= end_per_group -> 
1002
1279
                    add_to_stats(auto_skipped);
1003
1280
               true -> 
1056
1333
            File
1057
1334
    end.
1058
1335
 
 
1336
%%%-----------------------------------------------------------------
 
1337
%%% @spec overview_html_header(TestName) -> Header
 
1338
overview_html_header(TestName) ->
 
1339
    TestName1 = lists:flatten(io_lib:format("~p", [TestName])),
 
1340
    Label = case application:get_env(common_test, test_label) of
 
1341
                {ok,Lbl} when Lbl =/= undefined ->
 
1342
                    "<H1><FONT color=\"green\">" ++ Lbl ++ "</FONT></H1>\n";
 
1343
                _        ->
 
1344
                    ""
 
1345
            end,
 
1346
    Bgr = case ct_logs:basic_html() of
 
1347
              true ->
 
1348
                  "";
 
1349
              false ->
 
1350
                  CTPath = code:lib_dir(common_test),
 
1351
                  TileFile = filename:join(filename:join(CTPath,"priv"),"tile1.jpg"),
 
1352
                  " background=\"" ++ TileFile ++ "\""
 
1353
          end,
 
1354
 
 
1355
    ["<html>\n",
 
1356
     "<head><title>Test ", TestName1, " results</title>\n",
 
1357
     "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n",
 
1358
     "</head>\n",
 
1359
     "<body", Bgr, " bgcolor=\"white\" text=\"black\" ",
 
1360
     "link=\"blue\" vlink=\"purple\" alink=\"red\">\n",
 
1361
     Label,
 
1362
     "<H2>Results from test ", TestName1, "</H2>\n"].
1059
1363