← Back to branch summary

~clint-fewbar/ubuntu/precise/erlang/merge-15b

« back to all changes in this revision

Viewing changes to lib/test_server/src/test_server.erl

  • Committer: Package Import Robot
  • Author(s): Sergei Golovan
  • Date: 2011-12-15 19:20:10 UTC
  • mfrom: (1.1.18) (3.5.15 sid)
  • mto: (3.5.16 sid)
  • mto: This revision was merged to the branch mainline in revision 33.
  • Revision ID: package-import@ubuntu.com-20111215192010-jnxcfe3tbrpp0big
Tags: 1:15.b-dfsg-1
* New upstream release.
* Upload to experimental because this release breaks external drivers
  API along with ABI, so several applications are to be fixed.
* Removed SSL patch because the old SSL implementation is removed from
  the upstream distribution.
* Removed never used patch which added native code to erlang beam files.
* Removed the erlang-docbuilder binary package because the docbuilder
  application was dropped by upstream.
* Documented dropping ${erlang-docbuilder:Depends} substvar in
  erlang-depends(1) manpage.
* Made erlang-base and erlang-base-hipe provide virtual package
  erlang-abi-15.b (the number means the first erlang version, which
  provides current ABI).

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/test_server/src/test_server.erl
1
1
%%
2
2
%% %CopyrightBegin%
3
3
%%
4
 
%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
 
4
%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
5
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
36
36
-export([capture_start/0,capture_stop/0,capture_get/0]).
37
37
-export([messages_get/0]).
38
38
-export([hours/1,minutes/1,seconds/1,sleep/1,adjusted_sleep/1,timecall/3]).
39
 
-export([timetrap_scale_factor/0,timetrap/1,timetrap_cancel/1]).
 
39
-export([timetrap_scale_factor/0,timetrap/1,get_timetrap_info/0,
 
40
         timetrap_cancel/1,timetrap_cancel/0]).
40
41
-export([m_out_of_n/3,do_times/4,do_times/2]).
41
42
-export([call_crash/3,call_crash/4,call_crash/5]).
42
43
-export([temp_name/1]).
470
471
            overview ->
471
472
                fun(_) -> undefined end
472
473
        end,
473
 
    R = lists:map(
 
474
    R = pmap(
474
475
          fun(M) ->
475
476
                  case cover:analyse(M,module) of
476
477
                      {ok,{M,{Cov,NotCov}}} ->
486
487
    stick_all_sticky(node(),Sticky),
487
488
    R.
488
489
 
 
490
pmap(Fun,List) ->
 
491
    Collector = self(),
 
492
    Pids = lists:map(fun(E) ->
 
493
                             spawn(fun() ->
 
494
                                           Collector ! {res,self(),Fun(E)} 
 
495
                                   end) 
 
496
                     end, List),
 
497
    lists:map(fun(Pid) ->
 
498
                      receive
 
499
                          {res,Pid,Res} ->
 
500
                              Res
 
501
                      end
 
502
              end, Pids).
489
503
 
490
504
unstick_all_sticky(Node) ->
491
505
    lists:filter(
598
612
    print(minor, "Test case started with:\n~s:~s(~p)\n", [Mod,Func,Args2Print]),
599
613
    print(minor, "Current directory is ~p\n", [Cwd]),
600
614
    print_timestamp(minor,"Started at "),
 
615
    print(minor, "", [], internal_raw),
601
616
    TCCallback = get(test_server_testcase_callback),
 
617
    LogOpts = get(test_server_logopts),
602
618
    Ref = make_ref(),
603
619
    OldGLeader = group_leader(),
604
620
    %% Set ourself to group leader for the spawned process
608
624
          fun() ->
609
625
                  run_test_case_eval(Mod, Func, Args, Name, Ref,
610
626
                                     RunInit, TimetrapData,
611
 
                                     TCCallback)
 
627
                                     LogOpts, TCCallback)
612
628
          end),
613
629
    group_leader(OldGLeader, self()),
614
630
    put(test_server_detected_fail, []),
720
736
            print(Detail,Format,Args),
721
737
            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
722
738
        {comment,NewComment} ->
 
739
            NewComment1 = test_server_ctrl:to_string(NewComment),
 
740
            NewComment2 = test_server_sup:framework_call(format_comment,
 
741
                                                         [NewComment1],
 
742
                                                         NewComment1),
723
743
            Terminate1 =
724
744
                case Terminate of
725
745
                    {true,{Time,Value,Loc,Opts,_OldComment}} ->
726
 
                        {true,{Time,Value,mod_loc(Loc),Opts,NewComment}};
 
746
                        {true,{Time,Value,mod_loc(Loc),Opts,NewComment2}};
727
747
                    Other ->
728
748
                        Other
729
749
                end,
730
 
            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1,NewComment,CurrConf);
731
 
        {set_curr_conf,NewCurrConf} ->
 
750
            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate1,NewComment2,CurrConf);
 
751
        {read_comment,From} ->
 
752
            From ! {self(),read_comment,Comment},
 
753
            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
 
754
        {set_curr_conf,From,NewCurrConf} ->
 
755
            From ! {self(),set_curr_conf,ok},
732
756
            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,NewCurrConf);
733
757
        {'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} ->
734
758
            RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment},
740
764
                    case mod_loc(Loc) of
741
765
                        {FwMod,FwFunc,framework} ->
742
766
                            %% timout during framework call
743
 
                            spawn_fw_call(FwMod,FwFunc,Pid,
 
767
                            spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
744
768
                                          {framework_error,{timetrap,TVal}},
745
769
                                          unknown,self(),Comment),
746
770
                            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
747
771
                                                  Comment,undefined);
748
772
                        Loc1 ->
749
 
                            {Mod,Func} = get_mf(Loc1),
750
773
                            %% call end_per_testcase on a separate process,
751
774
                            %% only so that the user has a chance to clean up
752
775
                            %% after init_per_testcase, even after a timetrap timeout
762
785
                                                          TVal),
763
786
                                        {EndConfPid,{Mod,Func},Conf};
764
787
                                    _ ->
 
788
                                        {Mod,Func} = get_mf(Loc1),
765
789
                                        %% The framework functions mustn't execute on this
766
790
                                        %% group leader process or io will cause deadlock,
767
791
                                        %% so we spawn a dedicated process for the operation
768
792
                                        %% and let the group leader go back to handle io.
769
 
                                        spawn_fw_call(Mod,Func,Pid,{timetrap_timeout,TVal},
 
793
                                        spawn_fw_call(Mod,Func,CurrConf,Pid,
 
794
                                                      {timetrap_timeout,TVal},
770
795
                                                      Loc1,self(),Comment),
771
796
                                        undefined
772
797
                                end,
777
802
                    case mod_loc(Loc) of
778
803
                        {FwMod,FwFunc,framework} ->
779
804
                            %% timout during framework call
780
 
                            spawn_fw_call(FwMod,FwFunc,Pid,
 
805
                            spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
781
806
                                          {framework_error,{timetrap,TVal}},
782
807
                                          unknown,self(),Comment);
783
808
                        Loc1 ->
784
809
                            {Mod,_Func} = get_mf(Loc1),
785
 
                            spawn_fw_call(Mod,InitOrEnd,Pid,{timetrap_timeout,TVal},
 
810
                            spawn_fw_call(Mod,InitOrEnd,CurrConf,Pid,
 
811
                                          {timetrap_timeout,TVal},
786
812
                                          Loc1,self(),Comment)
787
813
                    end,
788
814
                    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
791
817
                    case mod_loc(AbortLoc) of
792
818
                        {FwMod,FwFunc,framework} ->
793
819
                            %% abort during framework call
794
 
                            spawn_fw_call(FwMod,FwFunc,Pid,
 
820
                            spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,
795
821
                                          {framework_error,ErrorMsg},
796
822
                                          unknown,self(),Comment),
797
823
                            run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,
798
824
                                                  Comment,undefined);
799
825
                        Loc1 ->
800
 
                            {Mod,Func} = get_mf(Loc1),
801
826
                            %% call end_per_testcase on a separate process, only so
802
827
                            %% that the user has a chance to clean up after init_per_testcase,
803
828
                            %% even after abortion
815
840
                                                          TVal),
816
841
                                        {EndConfPid,{Mod,Func},Conf};
817
842
                                    _ ->
818
 
                                        spawn_fw_call(Mod,Func,Pid,ErrorMsg,
 
843
                                        {Mod,Func} = get_mf(Loc1),
 
844
                                        spawn_fw_call(Mod,Func,CurrConf,Pid,ErrorMsg,
819
845
                                                      Loc1,self(),Comment),
820
846
                                        undefined
821
847
                                end,
826
852
                    %% result of an exit(TestCase,kill) call, which is the
827
853
                    %% only way to abort a testcase process that traps exits
828
854
                    %% (see abort_current_testcase)
829
 
                    spawn_fw_call(undefined,undefined,Pid,testcase_aborted_or_killed,
 
855
                    spawn_fw_call(undefined,undefined,CurrConf,Pid,
 
856
                                  testcase_aborted_or_killed,
830
857
                                  unknown,self(),Comment),
831
858
                    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
832
859
                {fw_error,{FwMod,FwFunc,FwError}} ->
833
 
                    spawn_fw_call(FwMod,FwFunc,Pid,{framework_error,FwError},
 
860
                    spawn_fw_call(FwMod,FwFunc,CurrConf,Pid,{framework_error,FwError},
834
861
                                  unknown,self(),Comment),
835
862
                    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf);
836
863
                _Other ->
837
864
                    %% the testcase has terminated because of Reason (e.g. an exit
838
865
                    %% because a linked process failed)
839
 
                    spawn_fw_call(undefined,undefined,Pid,Reason,
 
866
                    spawn_fw_call(undefined,undefined,CurrConf,Pid,Reason,
840
867
                                  unknown,self(),Comment),
841
868
                    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf)
842
869
            end;
844
871
            case CurrConf of
845
872
                {EndConfPid,{Mod,Func},_Conf} ->
846
873
                    {_Mod,_Func,TCPid,TCExitReason,Loc} = Data,
847
 
                    spawn_fw_call(Mod,Func,TCPid,TCExitReason,Loc,self(),Comment),
 
874
                    spawn_fw_call(Mod,Func,CurrConf,TCPid,TCExitReason,Loc,self(),Comment),
848
875
                    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,undefined);
849
876
                _ ->
850
877
                    run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate,Comment,CurrConf)
856
883
            %% a framework function failed
857
884
            CB = os:getenv("TEST_SERVER_FRAMEWORK"),
858
885
            Loc = case CB of
859
 
                      false ->
 
886
                      FW when FW =:= false; FW =:= "undefined" ->
860
887
                          {test_server,Func};
861
888
                      _ ->
862
889
                          {list_to_atom(CB),Func}
915
942
                                    ok
916
943
                            end,
917
944
                            Supervisor ! {self(),end_conf}
918
 
                       end,
 
945
                    end,
919
946
                Pid = spawn_link(EndConfApply),
920
947
                receive
921
948
                    {Pid,end_conf} ->
928
955
        end,
929
956
    spawn_link(EndConfProc).
930
957
 
931
 
spawn_fw_call(Mod,{init_per_testcase,Func},Pid,{timetrap_timeout,TVal}=Why,
 
958
spawn_fw_call(Mod,{init_per_testcase,Func},_,Pid,{timetrap_timeout,TVal}=Why,
932
959
              Loc,SendTo,Comment) ->
933
960
    FwCall =
934
961
        fun() ->
935
 
            Skip = {skip,{failed,{Mod,init_per_testcase,Why}}},
936
 
            %% if init_per_testcase fails, the test case
937
 
            %% should be skipped
938
 
            case catch test_server_sup:framework_call(
939
 
                         end_tc,[?pl2a(Mod),Func,{Pid,Skip,[[]]}]) of
940
 
                {'EXIT',FwEndTCErr} ->
941
 
                    exit({fw_notify_done,end_tc,FwEndTCErr});
942
 
                _ ->
943
 
                    ok
944
 
            end,
945
 
            %% finished, report back
946
 
            SendTo ! {self(),fw_notify_done,
947
 
                      {TVal/1000,Skip,Loc,[],Comment}}
 
962
                Skip = {skip,{failed,{Mod,init_per_testcase,Why}}},
 
963
                %% if init_per_testcase fails, the test case
 
964
                %% should be skipped
 
965
                case catch do_end_tc_call(Mod,Func, Loc, {Pid,Skip,[[]]}, Why) of
 
966
                    {'EXIT',FwEndTCErr} ->
 
967
                        exit({fw_notify_done,end_tc,FwEndTCErr});
 
968
                    _ ->
 
969
                        ok
 
970
                end,
 
971
                %% finished, report back
 
972
                SendTo ! {self(),fw_notify_done,
 
973
                          {TVal/1000,Skip,Loc,[],Comment}}
948
974
        end,
949
975
    spawn_link(FwCall);
950
976
 
951
 
spawn_fw_call(Mod,{end_per_testcase,Func},Pid,{timetrap_timeout,TVal}=Why,
952
 
              Loc,SendTo,_Comment) ->
 
977
spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid,
 
978
              {timetrap_timeout,TVal}=Why,_Loc,SendTo,Comment) ->
 
979
    %%! This is a temporary fix that keeps Test Server alive during
 
980
    %%! execution of a parallel test case group, when sometimes
 
981
    %%! this clause gets called with EndConf == undefined. See OTP-9594
 
982
    %%! for more info.
 
983
    EndConf1 = if EndConf == undefined ->
 
984
                       [{tc_status,{failed,{Mod,end_per_testcase,Why}}}];
 
985
                  true ->
 
986
                       EndConf
 
987
               end,
953
988
    FwCall =
954
989
        fun() ->
955
 
            Conf = [{tc_status,ok}],
956
 
            %% if end_per_testcase fails, the test case should be
957
 
            %% reported successful with a warning printed as comment
958
 
            case catch test_server_sup:framework_call(end_tc,
959
 
                                                      [?pl2a(Mod),Func,
960
 
                                                       {Pid,
961
 
                                                        {failed,{Mod,end_per_testcase,Why}},
962
 
                                                        [Conf]}]) of
963
 
                {'EXIT',FwEndTCErr} ->
964
 
                    exit({fw_notify_done,end_tc,FwEndTCErr});
965
 
                _ ->
966
 
                    ok
967
 
            end,
968
 
            %% finished, report back
969
 
            SendTo ! {self(),fw_notify_done,
970
 
                      {TVal/1000,{error,{Mod,end_per_testcase,Why}},Loc,[],
971
 
                       ["<font color=\"red\">"
972
 
                        "WARNING: end_per_testcase timed out!"
973
 
                        "</font>"]}}
 
990
                {RetVal,Report} =
 
991
                    case proplists:get_value(tc_status, EndConf1) of
 
992
                        undefined ->
 
993
                            E = {failed,{Mod,end_per_testcase,Why}},
 
994
                            {E,E};
 
995
                        E = {failed,Reason} ->
 
996
                            {E,{error,Reason}};
 
997
                        Result ->
 
998
                            E = {failed,{Mod,end_per_testcase,Why}},
 
999
                            {Result,E}
 
1000
                    end,
 
1001
                FailLoc = proplists:get_value(tc_fail_loc, EndConf1),
 
1002
                case catch do_end_tc_call(Mod,Func, FailLoc,
 
1003
                                          {Pid,Report,[EndConf1]}, Why) of
 
1004
                    {'EXIT',FwEndTCErr} ->
 
1005
                        exit({fw_notify_done,end_tc,FwEndTCErr});
 
1006
                    _ ->
 
1007
                        ok
 
1008
                end,
 
1009
                %% if end_per_testcase fails a warning should be
 
1010
                %% printed as comment
 
1011
                Comment1 = if Comment == "" -> 
 
1012
                                   "";
 
1013
                              true -> 
 
1014
                                   Comment ++ test_server_ctrl:xhtml("<br>",
 
1015
                                                                     "<br />")
 
1016
                           end,
 
1017
                %% finished, report back
 
1018
                SendTo ! {self(),fw_notify_done,
 
1019
                          {TVal/1000,RetVal,FailLoc,[],
 
1020
                           [Comment1,"<font color=\"red\">"
 
1021
                            "WARNING: end_per_testcase timed out!"
 
1022
                            "</font>"]}}
974
1023
        end,
975
1024
    spawn_link(FwCall);
976
1025
 
977
 
spawn_fw_call(FwMod,FwFunc,_Pid,{framework_error,FwError},_,SendTo,_Comment) ->
 
1026
spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo,_Comment) ->
978
1027
    FwCall =
979
1028
        fun() ->
980
1029
                test_server_sup:framework_call(report, [framework_error,
989
1038
        end,
990
1039
    spawn_link(FwCall);
991
1040
 
992
 
spawn_fw_call(Mod,Func,Pid,Error,Loc,SendTo,Comment) ->
 
1041
spawn_fw_call(Mod,Func,_,Pid,Error,Loc,SendTo,Comment) ->
993
1042
    FwCall =
994
1043
        fun() ->
995
1044
                case catch fw_error_notify(Mod,Func,[],
1001
1050
                        ok
1002
1051
                end,
1003
1052
                Conf = [{tc_status,{failed,timetrap_timeout}}],
1004
 
                case catch test_server_sup:framework_call(end_tc,
1005
 
                                                          [?pl2a(Mod),Func,
1006
 
                                                           {Pid,Error,[Conf]}]) of
 
1053
                case catch do_end_tc_call(Mod,Func, Loc,
 
1054
                                          {Pid,Error,[Conf]},Error) of
1007
1055
                    {'EXIT',FwEndTCErr} ->
1008
1056
                        exit({fw_notify_done,end_tc,FwEndTCErr});
1009
1057
                    _ ->
1064
1112
%% or sends a message {failed, File, Line} to it's group_leader
1065
1113
 
1066
1114
run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit,
1067
 
                   TimetrapData, TCCallback) ->
1068
 
    put(test_server_multiply_timetraps,TimetrapData),
 
1115
                   TimetrapData, LogOpts, TCCallback) ->
 
1116
    put(test_server_multiply_timetraps, TimetrapData),
 
1117
    put(test_server_logopts, LogOpts),
1069
1118
 
1070
1119
    {{Time,Value},Loc,Opts} =
1071
1120
        case test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0],
1073
1122
            {ok,Args} ->
1074
1123
                run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback);
1075
1124
            Error = {error,_Reason} ->
1076
 
                test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,{Error,Args0}]),
1077
 
                {{0,{skip,{failed,Error}}},{Mod,Func},[]};
 
1125
                Where = {Mod,Func},
 
1126
                NewResult = do_end_tc_call(Mod,Func, Where, {Error,Args0},
 
1127
                                           {skip,{failed,Error}}),
 
1128
                {{0,NewResult},Where,[]};
1078
1129
            {fail,Reason} ->
1079
 
                [Conf] = Args0,
1080
 
                Conf1 = [{tc_status,{failed,Reason}} | Conf],
 
1130
                Conf = [{tc_status,{failed,Reason}} | hd(Args0)],
 
1131
                Where = {Mod,Func},
1081
1132
                fw_error_notify(Mod, Func, Conf, Reason),
1082
 
                test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,
1083
 
                                                       {{error,Reason},[Conf1]}]),
1084
 
                {{0,{failed,Reason}},{Mod,Func},[]};
 
1133
                NewResult = do_end_tc_call(Mod,Func, Where, {{error,Reason},[Conf]},
 
1134
                                           {fail,Reason}),
 
1135
                {{0,NewResult},Where,[]};
1085
1136
            Skip = {skip,_Reason} ->
1086
 
                test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,{Skip,Args0}]),
1087
 
                {{0,Skip},{Mod,Func},[]};
 
1137
                Where = {Mod,Func},
 
1138
                NewResult = do_end_tc_call(Mod,Func, Where, {Skip,Args0}, Skip),
 
1139
                {{0,NewResult},Where,[]};
1088
1140
            {auto_skip,Reason} ->
1089
 
                test_server_sup:framework_call(end_tc,[?pl2a(Mod),
1090
 
                                                       Func,
1091
 
                                                       {{skip,Reason},Args0}]),
1092
 
                {{0,{skip,{fw_auto_skip,Reason}}},{Mod,Func},[]}
 
1141
                Where = {Mod,Func},
 
1142
                NewResult = do_end_tc_call(Mod,Func, Where, {{skip,Reason},Args0},
 
1143
                                           {skip,Reason}),
 
1144
                {{0,NewResult},Where,[]}
1093
1145
        end,
1094
1146
    exit({Ref,Time,Value,Loc,Opts}).
1095
1147
 
1103
1155
                Skip = {skip,Reason} ->
1104
1156
                    Line = get_loc(),
1105
1157
                    Conf = [{tc_status,{skipped,Reason}}],
1106
 
                    test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,{Skip,[Conf]}]),
1107
 
                    {{0,{skip,Reason}},Line,[]};
 
1158
                    NewRes = do_end_tc_call(Mod,Func, Line, {Skip,[Conf]}, Skip),
 
1159
                    {{0,NewRes},Line,[]};
1108
1160
                {skip_and_save,Reason,SaveCfg} ->
1109
1161
                    Line = get_loc(),
1110
1162
                    Conf = [{tc_status,{skipped,Reason}},{save_config,SaveCfg}],
1111
 
                    test_server_sup:framework_call(end_tc,[?pl2a(Mod),Func,
1112
 
                                                           {{skip,Reason},[Conf]}]),
1113
 
                    {{0,{skip,Reason}},Line,[]};
 
1163
                    NewRes = do_end_tc_call(Mod,Func, Line, {{skip,Reason},[Conf]},
 
1164
                                            {skip,Reason}),
 
1165
                    {{0,NewRes},Line,[]};
 
1166
                FailTC = {fail,Reason} ->       % user fails the testcase
 
1167
                    EndConf = [{tc_status,{failed,Reason}} | hd(Args)],
 
1168
                    fw_error_notify(Mod, Func, EndConf, Reason),
 
1169
                    NewRes = do_end_tc_call(Mod,Func, {Mod,Func},
 
1170
                                            {{error,Reason},[EndConf]},
 
1171
                                            FailTC),
 
1172
                    {{0,NewRes},{Mod,Func},[]};
1114
1173
                {ok,NewConf} ->
1115
1174
                    put(test_server_init_or_end_conf,undefined),
1116
1175
                    %% call user callback function if defined
1117
1176
                    NewConf1 = user_callback(TCCallback, Mod, Func, init, NewConf),
1118
1177
                    %% save current state in controller loop
1119
 
                    group_leader() ! {set_curr_conf,{{Mod,Func},NewConf1}},
 
1178
                    sync_send(group_leader(),set_curr_conf,{{Mod,Func},NewConf1},
 
1179
                              5000, fun() -> exit(no_answer_from_group_leader) end),
1120
1180
                    put(test_server_loc, {Mod,Func}),
1121
1181
                    %% execute the test case
1122
1182
                    {{T,Return},Loc} = {ts_tc(Mod, Func, [NewConf1]),get_loc()},
1123
1183
                    {EndConf,TSReturn,FWReturn} =
1124
1184
                        case Return of
1125
1185
                            {E,TCError} when E=='EXIT' ; E==failed ->
 
1186
                                ModLoc = mod_loc(Loc),
1126
1187
                                fw_error_notify(Mod, Func, NewConf1,
1127
 
                                                TCError, mod_loc(Loc)),
1128
 
                                {[{tc_status,{failed,TCError}}|NewConf1],
 
1188
                                                TCError, ModLoc),
 
1189
                                {[{tc_status,{failed,TCError}},
 
1190
                                  {tc_fail_loc,ModLoc}|NewConf1],
1129
1191
                                 Return,{error,TCError}};
1130
1192
                            SaveCfg={save_config,_} ->
1131
1193
                                {[{tc_status,ok},SaveCfg|NewConf1],Return,ok};
1132
1194
                            {skip_and_save,Why,SaveCfg} ->
1133
1195
                                Skip = {skip,Why},
1134
 
                                {[{tc_status,{skipped,Why}},{save_config,SaveCfg}|NewConf1],
 
1196
                                {[{tc_status,{skipped,Why}},
 
1197
                                  {save_config,SaveCfg}|NewConf1],
1135
1198
                                 Skip,Skip};
1136
1199
                            {skip,Why} ->
1137
1200
                                {[{tc_status,{skipped,Why}}|NewConf1],Return,Return};
1138
1201
                            _ ->
1139
1202
                                {[{tc_status,ok}|NewConf1],Return,ok}
1140
1203
                        end,
1141
 
                    %% clear current state in controller loop
1142
 
                    group_leader() ! {set_curr_conf,undefined},
1143
1204
                    %% call user callback function if defined
1144
1205
                    EndConf1 = user_callback(TCCallback, Mod, Func, 'end', EndConf),
 
1206
                    %% update current state in controller loop
 
1207
                    sync_send(group_leader(),set_curr_conf,EndConf1,
 
1208
                              5000, fun() -> exit(no_answer_from_group_leader) end),
1145
1209
                    {FWReturn1,TSReturn1,EndConf2} =
1146
1210
                        case end_per_testcase(Mod, Func, EndConf1) of
1147
1211
                            SaveCfg1={save_config,_} ->
1148
 
                                {FWReturn,TSReturn,[SaveCfg1|lists:keydelete(save_config, 1, EndConf1)]};
1149
 
                            {fail,ReasonToFail} ->                       % user has failed the testcase
 
1212
                                {FWReturn,TSReturn,[SaveCfg1|lists:keydelete(save_config,1,
 
1213
                                                                             EndConf1)]};
 
1214
                            {fail,ReasonToFail} ->
 
1215
                                %% user has failed the testcase
1150
1216
                                fw_error_notify(Mod, Func, EndConf1, ReasonToFail),
1151
1217
                                {{error,ReasonToFail},{failed,ReasonToFail},EndConf1};
1152
 
                            {failed,{_,end_per_testcase,_}} = Failure -> % unexpected termination
 
1218
                            {failed,{_,end_per_testcase,_}} = Failure when FWReturn == ok ->
 
1219
                                %% unexpected termination in end_per_testcase
 
1220
                                %% report this as the result to the framework
1153
1221
                                {Failure,TSReturn,EndConf1};
1154
1222
                            _ ->
 
1223
                                %% test case result should be reported to framework
 
1224
                                %% no matter the status of end_per_testcase
1155
1225
                                {FWReturn,TSReturn,EndConf1}
1156
1226
                        end,
 
1227
                    %% clear current state in controller loop
 
1228
                    sync_send(group_leader(),set_curr_conf,undefined,
 
1229
                              5000, fun() -> exit(no_answer_from_group_leader) end),
1157
1230
                    put(test_server_init_or_end_conf,undefined),
1158
 
                    case test_server_sup:framework_call(end_tc, [?pl2a(Mod), Func,
1159
 
                                                                 {FWReturn1,[EndConf2]}]) of
1160
 
                        {fail,Reason} ->
1161
 
                            fw_error_notify(Mod, Func, EndConf2, Reason),
1162
 
                            {{T,{failed,Reason}},{Mod,Func},[]};
1163
 
                        _ ->
1164
 
                            {{T,TSReturn1},Loc,[]}
 
1231
                    case do_end_tc_call(Mod,Func, Loc,
 
1232
                                        {FWReturn1,[EndConf2]}, TSReturn1) of
 
1233
                        {failed,Reason} = NewReturn ->
 
1234
                            fw_error_notify(Mod,Func,EndConf2, Reason),
 
1235
                            {{T,NewReturn},{Mod,Func},[]};
 
1236
                        NewReturn ->
 
1237
                            {{T,NewReturn},Loc,[]}
1165
1238
                    end
1166
1239
            end;
1167
1240
        skip_init ->
1179
1252
            {{T,Return},Loc} = {ts_tc(Mod, Func, Args2),get_loc()},
1180
1253
            %% call user callback function if defined
1181
1254
            Return1 = user_callback(TCCallback, Mod, Func, 'end', Return),
1182
 
            {Return2,Opts} = process_return_val([Return1], Mod,Func,Args1, Loc, Return1),
 
1255
            {Return2,Opts} = process_return_val([Return1], Mod, Func,
 
1256
                                                Args1, {Mod,Func}, Return1),
1183
1257
            {{T,Return2},Loc,Opts}
1184
1258
    end.
1185
1259
 
 
1260
do_end_tc_call(M,F, Loc, Res, Return) ->
 
1261
    IsSuite = case lists:reverse(atom_to_list(M)) of
 
1262
                  [$E,$T,$I,$U,$S,$_|_]  -> true;
 
1263
                  _ -> false
 
1264
              end,
 
1265
    FwMod = os:getenv("TEST_SERVER_FRAMEWORK"),
 
1266
    {Mod,Func} =
 
1267
        if FwMod == M ; FwMod == "undefined"; FwMod == false ->
 
1268
                {M,F};
 
1269
           (not IsSuite) and is_list(Loc) and (length(Loc)>1) ->
 
1270
                %% If failure in other module (M) than suite, try locate
 
1271
                %% suite name in Loc list and call end_tc with Suite:TestCase
 
1272
                %% instead of M:F.
 
1273
                GetSuite = fun(S,TC) ->
 
1274
                                   case lists:reverse(atom_to_list(S)) of
 
1275
                                       [$E,$T,$I,$U,$S,$_|_]  -> [{S,TC}];
 
1276
                                      _ -> []
 
1277
                                   end
 
1278
                          end,
 
1279
                case lists:flatmap(fun({S,TC,_})   -> GetSuite(S,TC);
 
1280
                                      ({{S,TC},_}) -> GetSuite(S,TC);
 
1281
                                      ({S,TC})     -> GetSuite(S,TC);
 
1282
                                      (_)          -> []
 
1283
                                   end, Loc) of
 
1284
                    [] ->
 
1285
                        {M,F};
 
1286
                    [FoundSuite|_] ->
 
1287
                        FoundSuite
 
1288
                end;
 
1289
           true ->
 
1290
                {M,F}
 
1291
        end,
 
1292
 
 
1293
    Ref = make_ref(),
 
1294
    if FwMod == "ct_framework" ; FwMod == "undefined"; FwMod == false ->
 
1295
            case test_server_sup:framework_call(
 
1296
                   end_tc, [?pl2a(Mod),Func,Res, Return], ok) of
 
1297
                {fail,FWReason} ->
 
1298
                    {failed,FWReason};
 
1299
                ok ->
 
1300
                    case Return of
 
1301
                        {fail,Reason} ->
 
1302
                            {failed,Reason};
 
1303
                        Return ->
 
1304
                            Return
 
1305
                    end;
 
1306
                NewReturn ->
 
1307
                    NewReturn
 
1308
            end;
 
1309
       true ->
 
1310
            case test_server_sup:framework_call(FwMod, end_tc,
 
1311
                                                [?pl2a(Mod),Func,Res], Ref) of
 
1312
                {fail,FWReason} ->
 
1313
                    {failed,FWReason};
 
1314
                _Else ->
 
1315
                    Return
 
1316
            end
 
1317
    end.
 
1318
 
1186
1319
%% the return value is a list and we have to check if it contains
1187
1320
%% the result of an end conf case or if it's a Config list
1188
1321
process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) ->
1197
1330
                   end, Return) of
1198
1331
        true ->              % must be return value from end conf case
1199
1332
            process_return_val1(Return, M,F,A, Loc, Final, []);
1200
 
        false ->             % must be Config value from init conf case
1201
 
            case test_server_sup:framework_call(end_tc, [?pl2a(M),F,{ok,A}]) of
1202
 
                {fail,FWReason} ->
 
1333
        false -> % must be Config value from init conf case
 
1334
            case do_end_tc_call(M, F, Loc, {ok,A}, Return) of
 
1335
                {failed, FWReason} = Failed ->
1203
1336
                    fw_error_notify(M,F,A, FWReason),
1204
 
                    {{failed,FWReason},[]};
1205
 
                _ ->
1206
 
                    {Return,[]}
 
1337
                    {Failed, []};
 
1338
                NewReturn ->
 
1339
                    {NewReturn, []}
1207
1340
            end
1208
1341
    end;
1209
1342
%% the return value is not a list, so it's the return value from an
1211
1344
process_return_val(Return, M,F,A, Loc, Final) ->
1212
1345
    process_return_val1(Return, M,F,A, Loc, Final, []).
1213
1346
 
1214
 
process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts) when E=='EXIT';
1215
 
                                                                                 E==failed ->
 
1347
process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts)
 
1348
  when E=='EXIT';
 
1349
       E==failed ->
1216
1350
    fw_error_notify(M,F,A, TCError, mod_loc(Loc)),
1217
 
    case test_server_sup:framework_call(end_tc,
1218
 
                                        [?pl2a(M),F,{{error,TCError},
1219
 
                                                     [[{tc_status,{failed,TCError}}|Args]]}]) of
1220
 
        {fail,FWReason} ->
 
1351
    case do_end_tc_call(M,F, Loc, {{error,TCError},
 
1352
                                   [[{tc_status,{failed,TCError}}|Args]]},
 
1353
                        Failed) of
 
1354
        {failed,FWReason} ->
1221
1355
            {{failed,FWReason},SaveOpts};
1222
 
        _ ->
1223
 
            {Failed,SaveOpts}
 
1356
        NewReturn ->
 
1357
            {NewReturn,SaveOpts}
1224
1358
    end;
1225
1359
process_return_val1([SaveCfg={save_config,_}|Opts], M,F,[Args], Loc, Final, SaveOpts) ->
1226
1360
    process_return_val1(Opts, M,F,[[SaveCfg|Args]], Loc, Final, SaveOpts);
1233
1367
    process_return_val1(Opts, M,F,A, Loc, RetVal, SaveOpts);
1234
1368
process_return_val1([_|Opts], M,F,A, Loc, Final, SaveOpts) ->
1235
1369
    process_return_val1(Opts, M,F,A, Loc, Final, SaveOpts);
1236
 
process_return_val1([], M,F,A, _Loc, Final, SaveOpts) ->
1237
 
    case test_server_sup:framework_call(end_tc, [?pl2a(M),F,{Final,A}]) of
1238
 
        {fail,FWReason} ->
 
1370
process_return_val1([], M,F,A, Loc, Final, SaveOpts) ->
 
1371
    case do_end_tc_call(M,F, Loc, {Final,A}, Final) of
 
1372
        {failed,FWReason} ->
1239
1373
            {{failed,FWReason},SaveOpts};
1240
 
        _ ->
1241
 
            {Final,lists:reverse(SaveOpts)}
 
1374
        NewReturn ->
 
1375
            {NewReturn,lists:reverse(SaveOpts)}
1242
1376
    end.
1243
1377
 
1244
1378
user_callback(undefined, _, _, _, Args) ->
1263
1397
        false -> code:load_file(Mod);
1264
1398
        _ -> ok
1265
1399
    end,
1266
 
    %% init_per_testcase defined, returns new configuration
1267
 
    case erlang:function_exported(Mod,init_per_testcase,2) of
 
1400
    case erlang:function_exported(Mod, init_per_testcase, 2) of
1268
1401
        true ->
1269
 
            case catch my_apply(Mod, init_per_testcase, [Func|Args]) of
1270
 
                {'$test_server_ok',{Skip,Reason}} when Skip==skip;
1271
 
                                                       Skip==skipped ->
1272
 
                    {skip,Reason};
1273
 
                {'$test_server_ok',Res={skip_and_save,_,_}} ->
1274
 
                    Res;
1275
 
                {'$test_server_ok',NewConf} when is_list(NewConf) ->
1276
 
                    case lists:filter(fun(T) when is_tuple(T) -> false;
1277
 
                                         (_) -> true end, NewConf) of
1278
 
                        [] ->
1279
 
                            {ok,NewConf};
1280
 
                        Bad ->
1281
 
                            group_leader() ! {printout,12,
1282
 
                                              "ERROR! init_per_testcase has returned "
1283
 
                                              "bad elements in Config: ~p\n",[Bad]},
1284
 
                            {skip,{failed,{Mod,init_per_testcase,bad_return}}}
1285
 
                    end;
1286
 
                {'$test_server_ok',_Other} ->
1287
 
                    group_leader() ! {printout,12,
1288
 
                                      "ERROR! init_per_testcase did not return "
1289
 
                                      "a Config list.\n",[]},
1290
 
                    {skip,{failed,{Mod,init_per_testcase,bad_return}}};
1291
 
                {'EXIT',Reason} ->
1292
 
                    Line = get_loc(),
1293
 
                    FormattedLoc = test_server_sup:format_loc(mod_loc(Line)),
1294
 
                    group_leader() ! {printout,12,
1295
 
                                      "ERROR! init_per_testcase crashed!\n"
1296
 
                                      "\tLocation: ~s\n\tReason: ~p\n",
1297
 
                                      [FormattedLoc,Reason]},
1298
 
                    {skip,{failed,{Mod,init_per_testcase,Reason}}};
1299
 
                Other ->
1300
 
                    Line = get_loc(),
1301
 
                    FormattedLoc = test_server_sup:format_loc(mod_loc(Line)),
1302
 
                    group_leader() ! {printout,12,
1303
 
                                      "ERROR! init_per_testcase thrown!\n"
1304
 
                                      "\tLocation: ~s\n\tReason: ~p\n",
1305
 
                                      [FormattedLoc, Other]},
1306
 
                    {skip,{failed,{Mod,init_per_testcase,Other}}}
1307
 
            end;
 
1402
            do_init_per_testcase(Mod, [Func|Args]);
1308
1403
        false ->
1309
 
            %% Optional init_per_testcase not defined
1310
 
            %% keep quiet.
 
1404
            %% Optional init_per_testcase is not defined -- keep quiet.
1311
1405
            [Config] = Args,
1312
1406
            {ok, Config}
1313
1407
    end.
1314
1408
 
 
1409
do_init_per_testcase(Mod, Args) ->
 
1410
    try apply(Mod, init_per_testcase, Args) of
 
1411
        {Skip,Reason} when Skip =:= skip; Skip =:= skipped ->
 
1412
            {skip,Reason};
 
1413
        {skip_and_save,_,_}=Res ->
 
1414
            Res;
 
1415
        NewConf when is_list(NewConf) ->
 
1416
            case lists:filter(fun(T) when is_tuple(T) -> false;
 
1417
                                 (_) -> true end, NewConf) of
 
1418
                [] ->
 
1419
                    {ok,NewConf};
 
1420
                Bad ->
 
1421
                    group_leader() ! {printout,12,
 
1422
                                      "ERROR! init_per_testcase has returned "
 
1423
                                      "bad elements in Config: ~p\n",[Bad]},
 
1424
                    {skip,{failed,{Mod,init_per_testcase,bad_return}}}
 
1425
            end;
 
1426
        {fail,_Reason}=Res ->
 
1427
            Res;
 
1428
        _Other ->
 
1429
            group_leader() ! {printout,12,
 
1430
                              "ERROR! init_per_testcase did not return "
 
1431
                              "a Config list.\n",[]},
 
1432
            {skip,{failed,{Mod,init_per_testcase,bad_return}}}
 
1433
    catch
 
1434
        throw:Other ->
 
1435
            set_loc(erlang:get_stacktrace()),
 
1436
            Line = get_loc(),
 
1437
            FormattedLoc = test_server_sup:format_loc(mod_loc(Line)),
 
1438
            group_leader() ! {printout,12,
 
1439
                              "ERROR! init_per_testcase thrown!\n"
 
1440
                              "\tLocation: ~s\n\tReason: ~p\n",
 
1441
                              [FormattedLoc, Other]},
 
1442
            {skip,{failed,{Mod,init_per_testcase,Other}}};
 
1443
        _:Reason0 ->
 
1444
            Stk = erlang:get_stacktrace(),
 
1445
            Reason = {Reason0,Stk},
 
1446
            set_loc(Stk),
 
1447
            Line = get_loc(),
 
1448
            FormattedLoc = test_server_sup:format_loc(mod_loc(Line)),
 
1449
            group_leader() ! {printout,12,
 
1450
                              "ERROR! init_per_testcase crashed!\n"
 
1451
                              "\tLocation: ~s\n\tReason: ~p\n",
 
1452
                              [FormattedLoc,Reason]},
 
1453
            {skip,{failed,{Mod,init_per_testcase,Reason}}}
 
1454
    end.
 
1455
 
1315
1456
end_per_testcase(Mod, Func, Conf) ->
1316
1457
    case erlang:function_exported(Mod,end_per_testcase,2) of
1317
1458
        true ->
1329
1470
do_end_per_testcase(Mod,EndFunc,Func,Conf) ->
1330
1471
    put(test_server_init_or_end_conf,{EndFunc,Func}),
1331
1472
    put(test_server_loc, {Mod,{EndFunc,Func}}),
1332
 
    case catch my_apply(Mod, EndFunc, [Func,Conf]) of
1333
 
        {'$test_server_ok',SaveCfg={save_config,_}} ->
 
1473
    try Mod:EndFunc(Func, Conf) of
 
1474
        {save_config,_}=SaveCfg ->
1334
1475
            SaveCfg;
1335
 
        {'$test_server_ok',{fail,_}=Fail} ->
 
1476
        {fail,_}=Fail ->
1336
1477
            Fail;
1337
 
        {'$test_server_ok',_} ->
1338
 
            ok;
1339
 
        {'EXIT',Reason} = Why ->
1340
 
            comment(io_lib:format("<font color=\"red\">"
 
1478
        _ ->
 
1479
            ok
 
1480
    catch
 
1481
        throw:Other ->
 
1482
            Comment0 = case read_comment() of
 
1483
                           ""  -> "";
 
1484
                           Cmt -> Cmt ++ test_server_ctrl:xhtml("<br>",
 
1485
                                                                "<br />")
 
1486
                       end,
 
1487
            set_loc(erlang:get_stacktrace()),
 
1488
            comment(io_lib:format("~s<font color=\"red\">"
 
1489
                                  "WARNING: ~w thrown!"
 
1490
                                  "</font>\n",[Comment0,EndFunc])),
 
1491
            group_leader() ! {printout,12,
 
1492
                              "WARNING: ~w thrown!\n"
 
1493
                              "Reason: ~p\n"
 
1494
                              "Line: ~s\n",
 
1495
                              [EndFunc, Other,
 
1496
                               test_server_sup:format_loc(
 
1497
                                 mod_loc(get_loc()))]},
 
1498
            {failed,{Mod,end_per_testcase,Other}};
 
1499
          Class:Reason ->
 
1500
            Stk = erlang:get_stacktrace(),
 
1501
            set_loc(Stk),
 
1502
            Why = case Class of
 
1503
                      exit -> {'EXIT',Reason};
 
1504
                      error -> {'EXIT',{Reason,Stk}}
 
1505
                  end,
 
1506
            Comment0 = case read_comment() of
 
1507
                           ""  -> "";
 
1508
                           Cmt -> Cmt ++ test_server_ctrl:xhtml("<br>",
 
1509
                                                                "<br />")
 
1510
                       end,
 
1511
            comment(io_lib:format("~s<font color=\"red\">"
1341
1512
                                  "WARNING: ~w crashed!"
1342
 
                                  "</font>\n",[EndFunc])),
 
1513
                                  "</font>\n",[Comment0,EndFunc])),
1343
1514
            group_leader() ! {printout,12,
1344
1515
                              "WARNING: ~w crashed!\n"
1345
1516
                              "Reason: ~p\n"
1347
1518
                              [EndFunc, Reason,
1348
1519
                               test_server_sup:format_loc(
1349
1520
                                 mod_loc(get_loc()))]},
1350
 
            {failed,{Mod,end_per_testcase,Why}};
1351
 
        Other ->
1352
 
            comment(io_lib:format("<font color=\"red\">"
1353
 
                                  "WARNING: ~w thrown!"
1354
 
                                  "</font>\n",[EndFunc])),
1355
 
            group_leader() ! {printout,12,
1356
 
                              "WARNING: ~w thrown!\n"
1357
 
                              "Reason: ~p\n"
1358
 
                              "Line: ~s\n",
1359
 
                              [EndFunc, Other,
1360
 
                               test_server_sup:format_loc(
1361
 
                                 mod_loc(get_loc()))]},
1362
 
            {failed,{Mod,end_per_testcase,Other}}
 
1521
            {failed,{Mod,end_per_testcase,Why}}
1363
1522
    end.
1364
1523
 
1365
1524
get_loc() ->
1366
 
    case catch test_server_line:get_lines() of
1367
 
        [] ->
1368
 
            get(test_server_loc);
1369
 
        {'EXIT',_} ->
1370
 
            get(test_server_loc);
1371
 
        Loc ->
1372
 
            Loc
1373
 
    end.
 
1525
    get(test_server_loc).
1374
1526
 
1375
1527
get_loc(Pid) ->
1376
 
    {dictionary,Dict} = process_info(Pid, dictionary),
1377
 
    lists:foreach(fun({Key,Val}) -> put(Key,Val) end,Dict),
 
1528
    [{current_stacktrace,Stk0},{dictionary,Dict}] =
 
1529
        process_info(Pid, [current_stacktrace,dictionary]),
 
1530
    lists:foreach(fun({Key,Val}) -> put(Key, Val) end, Dict),
 
1531
    Stk = [rewrite_loc_item(Loc) || Loc <- Stk0],
 
1532
    case get(test_server_loc) of
 
1533
        undefined -> put(test_server_loc, Stk);
 
1534
        _ -> ok
 
1535
    end,
1378
1536
    get_loc().
1379
1537
 
1380
 
get_mf([{M,F,_}|_]) -> {M,F};
1381
 
get_mf([{M,F}|_])   -> {M,F};
1382
 
get_mf(_)           -> {undefined,undefined}.
 
1538
%% find the latest known Suite:Testcase
 
1539
get_mf(MFs) ->
 
1540
    get_mf(MFs, {undefined,undefined}).
 
1541
 
 
1542
get_mf([MF|MFs], _Found) when is_tuple(MF) ->
 
1543
    ModFunc = {Mod,_} = case MF of
 
1544
                            {M,F,_} -> {M,F};
 
1545
                            MF -> MF
 
1546
                        end,
 
1547
    case is_suite(Mod) of
 
1548
        true -> ModFunc;
 
1549
        false -> get_mf(MFs, ModFunc)
 
1550
    end;
 
1551
get_mf(_, Found) ->
 
1552
    Found.
 
1553
 
 
1554
is_suite(Mod) ->
 
1555
    case lists:reverse(atom_to_list(Mod)) of
 
1556
        "ETIUS" ++ _ -> true;
 
1557
        _ -> false
 
1558
    end.
1383
1559
 
1384
1560
mod_loc(Loc) ->
1385
1561
    %% handle diff line num versions
1409
1585
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1410
1586
 
1411
1587
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1412
 
%% print(Detail,Format,Args) -> ok
 
1588
%% print(Detail,Format,Args,Printer) -> ok
1413
1589
%% Detail = integer()
1414
1590
%% Format = string()
1415
1591
%% Args = [term()]
1420
1596
print(Detail,Format,Args) ->
1421
1597
    local_or_remote_apply({test_server_ctrl,print,[Detail,Format,Args]}).
1422
1598
 
 
1599
print(Detail,Format,Args,Printer) ->
 
1600
    local_or_remote_apply({test_server_ctrl,print,[Detail,Format,Args,Printer]}).
 
1601
 
1423
1602
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1424
1603
%% print_timsteamp(Detail,Leader) -> ok
1425
1604
%%
1452
1631
%% timer:tc/3
1453
1632
ts_tc(M, F, A) ->
1454
1633
    Before = erlang:now(),
1455
 
    Val = (catch my_apply(M, F, A)),
 
1634
    Result = try
 
1635
                 apply(M, F, A)
 
1636
             catch
 
1637
                 Type:Reason ->
 
1638
                     Stk = erlang:get_stacktrace(),
 
1639
                     set_loc(Stk),
 
1640
                     case Type of
 
1641
                         throw ->
 
1642
                             {failed,{thrown,Reason}};
 
1643
                         error ->
 
1644
                             {'EXIT',{Reason,Stk}};
 
1645
                         exit ->
 
1646
                             {'EXIT',Reason}
 
1647
                     end
 
1648
             end,
1456
1649
    After = erlang:now(),
1457
 
    Result = case Val of
1458
 
                 {'$test_server_ok', R} ->
1459
 
                     R; % test case ok
1460
 
                 {'EXIT',_Reason} = R ->
1461
 
                     R; % test case crashed
1462
 
                 Other ->
1463
 
                     {failed, {thrown,Other}} % test case was thrown
1464
 
          end,
1465
1650
    Elapsed =
1466
1651
        (element(1,After)*1000000000000
1467
1652
         +element(2,After)*1000000+element(3,After)) -
1469
1654
         +element(2,Before)*1000000+element(3,Before)),
1470
1655
    {Elapsed, Result}.
1471
1656
 
1472
 
my_apply(M, F, A) ->
1473
 
    {'$test_server_ok',apply(M, F, A)}.
 
1657
set_loc(Stk) ->
 
1658
    Loc = [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk],
 
1659
    put(test_server_loc, Loc).
 
1660
 
 
1661
rewrite_loc_item({M,F,_,Loc}) ->
 
1662
    {M,F,proplists:get_value(line, Loc, 0)}.
1474
1663
 
1475
1664
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1476
1665
 
1633
1822
%% to read when using this function, rather than exit directly.
1634
1823
fail(Reason) ->
1635
1824
    comment(cast_to_list(Reason)),
1636
 
    exit({suite_failed,Reason}).
 
1825
    try
 
1826
        exit({suite_failed,Reason})
 
1827
    catch
 
1828
        Class:R ->
 
1829
            case erlang:get_stacktrace() of
 
1830
                [{?MODULE,fail,1,_}|Stk] -> ok;
 
1831
                Stk -> ok
 
1832
            end,
 
1833
            erlang:raise(Class, R, Stk)
 
1834
    end.
1637
1835
 
1638
1836
cast_to_list(X) when is_list(X) -> X;
1639
1837
cast_to_list(X) when is_atom(X) -> atom_to_list(X);
1647
1845
%% Immediately calls exit. Included because test suites are easier
1648
1846
%% to read when using this function, rather than exit directly.
1649
1847
fail() ->
1650
 
    exit(suite_failed).
 
1848
    try
 
1849
        exit(suite_failed)
 
1850
    catch
 
1851
        Class:R ->
 
1852
            case erlang:get_stacktrace() of
 
1853
                [{?MODULE,fail,0,_}|Stk] -> ok;
 
1854
                Stk -> ok
 
1855
            end,
 
1856
            erlang:raise(Class, R, Stk)
 
1857
    end.
1651
1858
 
1652
1859
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1653
1860
%% break(Comment) -> ok
1657
1864
break(Comment) ->
1658
1865
    case erase(test_server_timetraps) of
1659
1866
        undefined -> ok;
1660
 
        List -> lists:foreach(fun(Ref) -> timetrap_cancel(Ref) end,List)
 
1867
        List -> lists:foreach(fun({Ref,_,_}) -> 
 
1868
                                      timetrap_cancel(Ref)
 
1869
                              end, List)
1661
1870
    end,
1662
1871
    io:format(user,
1663
1872
              "\n\n\n--- SEMIAUTOMATIC TESTING ---"
1738
1947
        {undefined,false} -> timetrap1(Timeout, false);
1739
1948
        {undefined,_} -> timetrap1(Timeout, true);
1740
1949
        {infinity,_} -> infinity;
 
1950
        {_Int,_Scale} when Timeout == infinity -> infinity;
1741
1951
        {Int,Scale} -> timetrap1(Timeout*Int, Scale)
1742
1952
    end.
1743
1953
 
1744
1954
timetrap1(Timeout, Scale) ->
1745
 
    Ref = spawn_link(test_server_sup,timetrap,[Timeout,Scale,self()]),
 
1955
    TCPid = self(),
 
1956
    Ref = spawn_link(test_server_sup,timetrap,[Timeout,Scale,TCPid]),
1746
1957
    case get(test_server_timetraps) of
1747
 
        undefined -> put(test_server_timetraps,[Ref]);
1748
 
        List -> put(test_server_timetraps,[Ref|List])
 
1958
        undefined -> put(test_server_timetraps,[{Ref,TCPid,{Timeout,Scale}}]);
 
1959
        List -> put(test_server_timetraps,[{Ref,TCPid,{Timeout,Scale}}|List])
1749
1960
    end,
1750
1961
    Ref.
1751
1962
 
1758
1969
                undefined -> ok;
1759
1970
                Garbage ->
1760
1971
                    erase(test_server_default_timetrap),
1761
 
                    format("=== WARNING: garbage in test_server_default_timetrap: ~p~n",
 
1972
                    format("=== WARNING: garbage in "
 
1973
                           "test_server_default_timetrap: ~p~n",
1762
1974
                           [Garbage])
1763
1975
            end,
1764
1976
            DTmo = case lists:keysearch(default_timeout,1,Config) of
1765
1977
                       {value,{default_timeout,Tmo}} -> Tmo;
1766
1978
                       _ -> ?DEFAULT_TIMETRAP_SECS
1767
1979
                   end,
1768
 
            format("=== test_server setting default timetrap of ~p seconds~n",
 
1980
            format("=== test_server setting default "
 
1981
                   "timetrap of ~p seconds~n",
1769
1982
                   [DTmo]),
1770
1983
            put(test_server_default_timetrap, timetrap(seconds(DTmo)))
1771
1984
    end.
1777
1990
        TimeTrap when is_pid(TimeTrap) ->
1778
1991
            timetrap_cancel(TimeTrap),
1779
1992
            erase(test_server_default_timetrap),
1780
 
            format("=== test_server canceled default timetrap since another timetrap was set~n"),
 
1993
            format("=== test_server canceled default timetrap "
 
1994
                   "since another timetrap was set~n"),
1781
1995
            ok;
1782
1996
        Garbage ->
1783
1997
            erase(test_server_default_timetrap),
1784
 
            format("=== WARNING: garbage in test_server_default_timetrap: ~p~n",
 
1998
            format("=== WARNING: garbage in "
 
1999
                   "test_server_default_timetrap: ~p~n",
1785
2000
                   [Garbage]),
1786
2001
            error
1787
2002
    end.
1793
2008
time_ms({Other,_N}) ->
1794
2009
    format("=== ERROR: Invalid time specification: ~p. "
1795
2010
           "Should be seconds, minutes, or hours.~n", [Other]),
1796
 
    exit({invalid_time_spec,Other});
 
2011
    exit({invalid_time_format,Other});
1797
2012
time_ms(Ms) when is_integer(Ms) -> Ms;
1798
 
time_ms(Other) -> exit({invalid_time_spec,Other}).
1799
 
 
 
2013
time_ms(infinity) -> infinity;
 
2014
time_ms(Fun) when is_function(Fun) ->
 
2015
    time_ms_apply(Fun);
 
2016
time_ms({M,F,A}=MFA) when is_atom(M), is_atom(F), is_list(A) ->
 
2017
    time_ms_apply(MFA);
 
2018
time_ms(Other) -> exit({invalid_time_format,Other}).
 
2019
 
 
2020
time_ms_apply(Func) ->
 
2021
    time_ms_apply(Func, [5000,30000,60000,infinity]).
 
2022
 
 
2023
time_ms_apply(Func, TOs) ->
 
2024
    Apply = fun() ->
 
2025
                    case Func of
 
2026
                        {M,F,A} ->
 
2027
                            exit({self(),apply(M, F, A)});
 
2028
                        Fun ->
 
2029
                            exit({self(),Fun()})
 
2030
                    end
 
2031
            end,
 
2032
    Pid = spawn(Apply),
 
2033
    Ref = monitor(process, Pid),
 
2034
    time_ms_wait(Func, Pid, Ref, TOs).
 
2035
 
 
2036
time_ms_wait(Func, Pid, Ref, [TO|TOs]) ->
 
2037
    receive
 
2038
        {'DOWN',Ref,process,Pid,{Pid,Result}} ->
 
2039
            time_ms_check(Result);
 
2040
        {'DOWN',Ref,process,Pid,Error} ->
 
2041
            exit({timetrap_error,Error})
 
2042
    after
 
2043
        TO ->
 
2044
            format("=== WARNING: No return from timetrap function ~p~n", [Func]),
 
2045
            time_ms_wait(Func, Pid, Ref, TOs)
 
2046
    end;
 
2047
%% this clause will never execute if 'infinity' is in TOs list, that's ok!
 
2048
time_ms_wait(Func, Pid, Ref, []) ->
 
2049
    demonitor(Ref),
 
2050
    exit(Pid, kill),
 
2051
    exit({timetrap_error,{no_return_from_timetrap_function,Func}}).
 
2052
 
 
2053
time_ms_check(MFA = {M,F,A}) when is_atom(M), is_atom(F), is_list(A) ->
 
2054
    exit({invalid_time_format,MFA});
 
2055
time_ms_check(Fun) when is_function(Fun) ->
 
2056
    exit({invalid_time_format,Fun});
 
2057
time_ms_check(Other) ->
 
2058
    time_ms(Other).
1800
2059
 
1801
2060
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1802
2061
%% timetrap_cancel(Handle) -> ok
1808
2067
timetrap_cancel(Handle) ->
1809
2068
    case get(test_server_timetraps) of
1810
2069
        undefined -> ok;
1811
 
        [Handle] -> erase(test_server_timetraps);
1812
 
        List -> put(test_server_timetraps,lists:delete(Handle,List))
 
2070
        [{Handle,_,_}] -> erase(test_server_timetraps);
 
2071
        Timers -> put(test_server_timetraps,
 
2072
                      lists:keydelete(Handle, 1, Timers))
1813
2073
    end,
1814
2074
    test_server_sup:timetrap_cancel(Handle).
1815
2075
 
 
2076
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
2077
%% timetrap_cancel() -> ok
 
2078
%%
 
2079
%% Cancels timetrap for current test case.
 
2080
timetrap_cancel() ->
 
2081
    case get(test_server_timetraps) of
 
2082
        undefined ->
 
2083
            ok;
 
2084
        Timers ->
 
2085
            case lists:keysearch(self(), 2, Timers) of
 
2086
                {value,{Handle,_,_}} ->
 
2087
                    timetrap_cancel(Handle);
 
2088
                _ ->
 
2089
                    ok
 
2090
            end
 
2091
    end.
 
2092
 
 
2093
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
2094
%% get_timetrap_info() -> {Timeout,Scale} | undefined
 
2095
%%
 
2096
%% Read timetrap info for current test case
 
2097
get_timetrap_info() ->
 
2098
    case get(test_server_timetraps) of
 
2099
        undefined ->
 
2100
            undefined;
 
2101
        Timers ->
 
2102
            case lists:keysearch(self(), 2, Timers) of
 
2103
                {value,{_,_,Info}} ->
 
2104
                    Info;
 
2105
                _ ->
 
2106
                    undefined
 
2107
            end
 
2108
    end.
 
2109
 
1816
2110
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1817
2111
%% hours(N) -> Milliseconds
1818
2112
%% minutes(N) -> Milliseconds
1826
2120
minutes(N) -> trunc(N * 1000 * 60).
1827
2121
seconds(N) -> trunc(N * 1000).
1828
2122
 
 
2123
 
 
2124
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
2125
%% sync_send(Pid,Tag,Msg,Timeout,DoAfter) -> Result
 
2126
%%
 
2127
sync_send(Pid,Tag,Msg,Timeout,DoAfter) ->
 
2128
    Pid ! {Tag,self(),Msg},
 
2129
    receive
 
2130
        {Pid,Tag,Result} ->
 
2131
            Result
 
2132
    after Timeout ->
 
2133
            DoAfter()
 
2134
    end.
 
2135
 
1829
2136
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1830
2137
%% timecall(M,F,A) -> {Time,Val}
1831
2138
%% Time = float()
2212
2519
    group_leader() ! {comment,String},
2213
2520
    ok.
2214
2521
 
 
2522
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
2523
%% read_comment() -> string()
 
2524
%%
 
2525
%% Read the current comment string stored in
 
2526
%% state during test case execution.
 
2527
read_comment() ->
 
2528
    MsgLooper = group_leader(),
 
2529
    MsgLooper ! {read_comment,self()},
 
2530
    receive
 
2531
        {MsgLooper,read_comment,Comment} ->
 
2532
            Comment
 
2533
    after
 
2534
        5000 ->
 
2535
            ""
 
2536
    end.
2215
2537
 
2216
2538
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2217
2539
%% os_type() -> OsType