1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 1996-2020. All Rights Reserved. 5%% 6%% Licensed under the Apache License, Version 2.0 (the "License"); 7%% you may not use this file except in compliance with the License. 8%% You may obtain a copy of the License at 9%% 10%% http://www.apache.org/licenses/LICENSE-2.0 11%% 12%% Unless required by applicable law or agreed to in writing, software 13%% distributed under the License is distributed on an "AS IS" BASIS, 14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15%% See the License for the specific language governing permissions and 16%% limitations under the License. 17%% 18%% %CopyrightEnd% 19-module(test_server). 20 21-define(DEFAULT_TIMETRAP_SECS, 60). 22 23%%% TEST_SERVER_CTRL INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 24-export([run_test_case_apply/1,init_target_info/0,init_valgrind/0]). 25-export([cover_compile/1,cover_analyse/2]). 26 27%%% TEST_SERVER_SUP INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 28-export([get_loc/1,set_tc_state/1]). 29 30%%% TEST SUITE INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 31-export([lookup_config/2]). 32-export([fail/0,fail/1,format/1,format/2,format/3]). 33-export([capture_start/0,capture_stop/0,capture_get/0]). 34-export([messages_get/0]). 35-export([permit_io/2]). 36-export([hours/1,minutes/1,seconds/1,sleep/1,adjusted_sleep/1,timecall/3]). 37-export([timetrap_scale_factor/0,timetrap/1,get_timetrap_info/0, 38 timetrap_cancel/1,timetrap_cancel/0]). 39-export([m_out_of_n/3,do_times/4,do_times/2]). 40-export([call_crash/3,call_crash/4,call_crash/5]). 41-export([temp_name/1]). 42-export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]). 43-export([app_test/1, app_test/2, appup_test/1]). 44-export([is_native/1]). 45-export([comment/1, make_priv_dir/0]). 46-export([os_type/0]). 47-export([run_on_shielded_node/2]). 48-export([is_cover/0,is_debug/0,is_commercial/0]). 49 50-export([break/1,break/2,break/3,continue/0,continue/1]). 51 52%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 53-export([valgrind_new_leaks/0, valgrind_format/2, 54 is_valgrind/0]). 55 56%%% PRIVATE EXPORTED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 57-export([]). 58 59%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 60-include("test_server_internal.hrl"). 61-include_lib("kernel/include/file.hrl"). 62 63init_target_info() -> 64 [$.|Emu] = code:objfile_extension(), 65 {_, OTPRel} = init:script_id(), 66 #target_info{os_family=test_server_sup:get_os_family(), 67 os_type=os:type(), 68 version=erlang:system_info(version), 69 system_version=erlang:system_info(system_version), 70 root_dir=code:root_dir(), 71 emulator=Emu, 72 otp_release=OTPRel, 73 username=test_server_sup:get_username(), 74 cookie=atom_to_list(erlang:get_cookie())}. 75 76init_valgrind() -> 77 valgrind_new_leaks(). 78 79 80%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 81%% cover_compile(#cover{app=App,incl=Include,excl=Exclude,cross=Cross}) -> 82%% {ok,#cover{mods=AnalyseModules}} | {error,Reason} 83%% 84%% App = atom() , name of application to be compiled 85%% Exclude = [atom()], list of modules to exclude 86%% Include = [atom()], list of modules outside of App that should be included 87%% in the cover compilation 88%% Cross = [atoms()], list of modules outside of App shat should be included 89%% in the cover compilation, but that shall not be part of 90%% the cover analysis for this application. 91%% AnalyseModules = [atom()], list of successfully compiled modules 92%% 93%% Cover compile the given application. Return {ok,CoverInfo} if 94%% compilation succeeds, else (if application is not found and there 95%% are no modules to compile) {error,application_not_found}. 96 97cover_compile(CoverInfo=#cover{app=none,incl=Include,cross=Cross}) -> 98 CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross), 99 CompileMods = Include++CrossMods, 100 case length(CompileMods) of 101 0 -> 102 io:fwrite("WARNING: No modules to cover compile!\n\n",[]), 103 {ok, _} = start_cover(), % start cover server anyway 104 {ok,CoverInfo#cover{mods=[]}}; 105 N -> 106 io:fwrite("Cover compiling ~w modules - " 107 "this may take some time... ",[N]), 108 do_cover_compile(CompileMods), 109 io:fwrite("done\n\n",[]), 110 {ok,CoverInfo#cover{mods=Include}} 111 end; 112cover_compile(CoverInfo=#cover{app=App,excl=all,incl=Include,cross=Cross}) -> 113 CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross), 114 CompileMods = Include++CrossMods, 115 case length(CompileMods) of 116 0 -> 117 io:fwrite("WARNING: No modules to cover compile!\n\n",[]), 118 {ok, _} = start_cover(), % start cover server anyway 119 {ok,CoverInfo#cover{mods=[]}}; 120 N -> 121 io:fwrite("Cover compiling '~w' (~w files) - " 122 "this may take some time... ",[App,N]), 123 io:format("\nWARNING: All modules in \'~w\' are excluded\n" 124 "Only cover compiling modules in include list " 125 "and the modules\nin the cross cover file:\n" 126 "~tp\n", [App,CompileMods]), 127 do_cover_compile(CompileMods), 128 io:fwrite("done\n\n",[]), 129 {ok,CoverInfo#cover{mods=Include}} 130 end; 131cover_compile(CoverInfo=#cover{app=App,excl=Exclude, 132 incl=Include,cross=Cross}) -> 133 CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross), 134 case code:lib_dir(App) of 135 {error,bad_name} -> 136 case Include++CrossMods of 137 [] -> 138 io:format("\nWARNING: Can't find lib_dir for \'~w\'\n" 139 "Not cover compiling!\n\n",[App]), 140 {error,application_not_found}; 141 CompileMods -> 142 io:fwrite("Cover compiling '~w' (~w files) - " 143 "this may take some time... ", 144 [App,length(CompileMods)]), 145 io:format("\nWARNING: Can't find lib_dir for \'~w\'\n" 146 "Only cover compiling modules in include list: " 147 "~tp\n", [App,Include]), 148 do_cover_compile(CompileMods), 149 io:fwrite("done\n\n",[]), 150 {ok,CoverInfo#cover{mods=Include}} 151 end; 152 LibDir -> 153 EbinDir = filename:join([LibDir,"ebin"]), 154 WC = filename:join(EbinDir,"*.beam"), 155 AllMods = module_names(filelib:wildcard(WC)), 156 AnalyseMods = (AllMods ++ Include) -- Exclude, 157 CompileMods = AnalyseMods ++ CrossMods, 158 case length(CompileMods) of 159 0 -> 160 io:fwrite("WARNING: No modules to cover compile!\n\n",[]), 161 {ok, _} = start_cover(), % start cover server anyway 162 {ok,CoverInfo#cover{mods=[]}}; 163 N -> 164 io:fwrite("Cover compiling '~w' (~w files) - " 165 "this may take some time... ",[App,N]), 166 do_cover_compile(CompileMods), 167 io:fwrite("done\n\n",[]), 168 {ok,CoverInfo#cover{mods=AnalyseMods}} 169 end 170 end. 171 172 173module_names(Beams) -> 174 [list_to_atom(filename:basename(filename:rootname(Beam))) || Beam <- Beams]. 175 176 177do_cover_compile(Modules) -> 178 {ok, _} = start_cover(), 179 Sticky = prepare_cover_compile(Modules,[]), 180 R = cover:compile_beam(Modules), 181 _ = [warn_compile(Error) || Error <- R,element(1,Error)=/=ok], 182 _ = [code:stick_mod(M) || M <- Sticky], 183 ok. 184 185warn_compile({error,{Reason,Module}}) -> 186 io:fwrite("\nWARNING: Could not cover compile ~ts: ~tp\n", 187 [Module,{error,Reason}]). 188 189%% Make sure all modules are loaded and unstick if sticky 190prepare_cover_compile([M|Ms],Sticky) -> 191 case {code:is_sticky(M),code:is_loaded(M)} of 192 {true,_} -> 193 code:unstick_mod(M), 194 prepare_cover_compile(Ms,[M|Sticky]); 195 {false,false} -> 196 case code:load_file(M) of 197 {module,_} -> 198 prepare_cover_compile([M|Ms],Sticky); 199 Error -> 200 io:fwrite("\nWARNING: Could not load ~w: ~tp\n",[M,Error]), 201 prepare_cover_compile(Ms,Sticky) 202 end; 203 {false,_} -> 204 prepare_cover_compile(Ms,Sticky) 205 end; 206prepare_cover_compile([],Sticky) -> 207 Sticky. 208 209%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 210%% cover_analyse(Dir,#cover{level=Analyse,mods=Modules,stop=Stop) -> 211%% [{M,{Cov,NotCov,Details}}] 212%% 213%% Dir = string() 214%% Analyse = details | overview 215%% Modules = [atom()], the modules to analyse 216%% 217%% Cover analysis. If Analyse==details analyse_to_file is used. 218%% 219%% If Analyse==overview analyse_to_file is not used, only an overview 220%% containing the number of covered/not covered lines in each module. 221%% 222%% Also, cover data will be exported to a file called all.coverdata in 223%% the given directory. 224%% 225%% Finally, if Stop==true, then cover will be stopped after the 226%% analysis is completed. Stopping cover causes the original (non 227%% cover compiled) modules to be loaded back in. If a process at this 228%% point is still running old code of any of the cover compiled 229%% modules, meaning that is has not done any fully qualified function 230%% call after the cover compilation, the process will now be 231%% killed. To avoid this scenario, it is possible to set Stop=false, 232%% which means that the modules will stay cover compiled. Note that 233%% this is only recommended if the erlang node is being terminated 234%% after the test is completed. 235cover_analyse(Dir,#cover{level=Analyse,mods=Modules,stop=Stop}) -> 236 io:fwrite(user, "Cover analysing... ", []), 237 {ATFOk,ATFFail} = 238 case Analyse of 239 details -> 240 case cover:export(filename:join(Dir,"all.coverdata")) of 241 ok -> 242 {result,Ok1,Fail1} = 243 cover:analyse_to_file(Modules,[{outdir,Dir},html]), 244 {lists:map(fun(OutFile) -> 245 M = list_to_atom( 246 filename:basename( 247 filename:rootname(OutFile, 248 ".COVER.html") 249 ) 250 ), 251 {M,{file,OutFile}} 252 end, Ok1), 253 lists:map(fun({Reason,M}) -> 254 {M,{error,Reason}} 255 end, Fail1)}; 256 Error -> 257 {[],lists:map(fun(M) -> {M,Error} end, Modules)} 258 end; 259 overview -> 260 case cover:export(filename:join(Dir,"all.coverdata")) of 261 ok -> 262 {[],lists:map(fun(M) -> {M,undefined} end, Modules)}; 263 Error -> 264 {[],lists:map(fun(M) -> {M,Error} end, Modules)} 265 end 266 end, 267 {result,AOk,AFail} = cover:analyse(Modules,module), 268 R0 = merge_analysis_results(AOk,ATFOk++ATFFail,[]) ++ 269 [{M,{error,Reason}} || {Reason,M} <- AFail], 270 R = lists:sort(R0), 271 io:fwrite(user, "done\n\n", []), 272 273 case Stop of 274 true -> 275 Sticky = unstick_all_sticky(node()), 276 cover:stop(), 277 stick_all_sticky(node(),Sticky); 278 false -> 279 ok 280 end, 281 R. 282 283merge_analysis_results([{M,{Cov,NotCov}}|T],ATF,Acc) -> 284 case lists:keytake(M,1,ATF) of 285 {value,{_,R},ATF1} -> 286 merge_analysis_results(T,ATF1,[{M,{Cov,NotCov,R}}|Acc]); 287 false -> 288 merge_analysis_results(T,ATF,Acc) 289 end; 290merge_analysis_results([],_,Acc) -> 291 Acc. 292 293do_cover_for_node(Node,CoverFunc) -> 294 do_cover_for_node(Node,CoverFunc,true). 295do_cover_for_node(Node,CoverFunc,StickUnstick) -> 296 %% In case a slave node is starting another slave node! I.e. this 297 %% function is executed on a slave node - then the cover function 298 %% must be executed on the master node. This is for instance the 299 %% case in test_server's own tests. 300 MainCoverNode = cover:get_main_node(), 301 Sticky = 302 if StickUnstick -> unstick_all_sticky(MainCoverNode,Node); 303 true -> ok 304 end, 305 rpc:call(MainCoverNode,cover,CoverFunc,[Node]), 306 if StickUnstick -> stick_all_sticky(Node,Sticky); 307 true -> ok 308 end. 309 310unstick_all_sticky(Node) -> 311 unstick_all_sticky(node(),Node). 312unstick_all_sticky(MainCoverNode,Node) -> 313 lists:filter( 314 fun(M) -> 315 case code:is_sticky(M) of 316 true -> 317 rpc:call(Node,code,unstick_mod,[M]), 318 true; 319 false -> 320 false 321 end 322 end, 323 rpc:call(MainCoverNode,cover,modules,[])). 324 325stick_all_sticky(Node,Sticky) -> 326 lists:foreach( 327 fun(M) -> 328 rpc:call(Node,code,stick_mod,[M]) 329 end, 330 Sticky). 331 332 333%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 334%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData) -> 335%% {Time,Value,Loc,Opts,Comment} | {died,Reason,unknown,Comment} 336%% 337%% Time = float() (seconds) 338%% Value = term() 339%% Loc = term() 340%% Comment = string() 341%% Reason = term() 342%% 343%% Spawns off a process (case process) that actually runs the test suite. 344%% The case process will have the job process as group leader, which makes 345%% it possible to capture all it's output from io:format/2, etc. 346%% 347%% The job process then sits down and waits for news from the case process. 348%% 349%% Returns a tuple with the time spent (in seconds) in the test case, 350%% the return value from the test case or an {'EXIT',Reason} if the case 351%% failed, Loc points out where the test case crashed (if it did). Loc 352%% is either the name of the function, or {<Module>,<Line>} of the last 353%% line executed that had a ?line macro. If the test case did execute 354%% erase/0 or similar, it may be empty. Comment is the last comment added 355%% by test_server:comment/1, the reason if test_server:fail has been 356%% called or the comment given by the return value {comment,Comment} from 357%% a test case. 358%% 359%% {died,Reason,unknown,Comment} is returned if the test case was killed 360%% by some other process. Reason is the kill reason provided. 361%% 362%% TimetrapData = {MultiplyTimetrap,ScaleTimetrap}, which indicates a 363%% possible extension of all timetraps. Timetraps will be multiplied by 364%% MultiplyTimetrap. If it is infinity, no timetraps will be started at all. 365%% ScaleTimetrap indicates if test_server should attemp to automatically 366%% compensate timetraps for runtime delays introduced by e.g. tools like 367%% cover. 368 369run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,TimetrapData}) -> 370 case is_valgrind() of 371 false -> 372 ok; 373 true -> 374 valgrind_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]), 375 os:putenv("VALGRIND_LOGFILE_INFIX",atom_to_list(Mod)++"."++ 376 atom_to_list(Func)++"-") 377 end, 378 ProcBef = erlang:system_info(process_count), 379 Result = run_test_case_apply(Mod, Func, Args, Name, RunInit, 380 TimetrapData), 381 ProcAft = erlang:system_info(process_count), 382 valgrind_new_leaks(), 383 DetFail = get(test_server_detected_fail), 384 {Result,DetFail,ProcBef,ProcAft}. 385 386-type tc_status() :: 'starting' | 'running' | 'init_per_testcase' | 387 'end_per_testcase' | {'framework',{atom(),atom(),list}} | 388 'tc'. 389-record(st, 390 { 391 ref :: reference(), 392 pid :: pid(), 393 mf :: {atom(),atom()}, 394 last_known_loc :: term(), 395 status :: tc_status() | 'undefined', 396 ret_val :: term(), 397 comment :: list(char()), 398 timeout :: non_neg_integer() | 'infinity', 399 config :: list() | 'undefined', 400 end_conf_pid :: pid() | 'undefined' 401 }). 402 403run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> 404 print_timestamp(minor,"Started at "), 405 print(minor, "", [], internal_raw), 406 TCCallback = get(test_server_testcase_callback), 407 LogOpts = get(test_server_logopts), 408 Ref = make_ref(), 409 Pid = 410 spawn_link( 411 run_test_case_eval_fun(Mod, Func, Args, Name, Ref, 412 RunInit, TimetrapData, 413 LogOpts, TCCallback)), 414 put(test_server_detected_fail, []), 415 St = #st{ref=Ref,pid=Pid,mf={Mod,Func},last_known_loc=unknown, 416 status=starting,ret_val=[],comment="",timeout=infinity, 417 config=hd(Args)}, 418 ct_util:mark_process(), 419 run_test_case_msgloop(St). 420 421%% Ugly bug (pre R5A): 422%% If this process (group leader of the test case) terminates before 423%% all messages have been replied back to the io server, the io server 424%% hangs. Fixed by the 20 milli timeout check here, and by using monitor in 425%% io.erl. 426%% 427%% A test case is known to have failed if it returns {'EXIT', _} tuple, 428%% or sends a message {failed, File, Line} to it's group_leader 429%% 430run_test_case_msgloop(#st{ref=Ref,pid=Pid,end_conf_pid=EndConfPid0}=St0) -> 431 receive 432 {set_tc_state=Tag,From,{Status,Config0}} -> 433 Config = case Config0 of 434 unknown -> St0#st.config; 435 _ -> Config0 436 end, 437 St = St0#st{status=Status,config=Config}, 438 From ! {self(),Tag,ok}, 439 run_test_case_msgloop(St); 440 {abort_current_testcase,_,_}=Abort when St0#st.status =:= starting -> 441 %% we're in init phase, must must postpone this operation 442 %% until test case execution is in progress (or FW:init_tc 443 %% gets killed) 444 self() ! Abort, 445 erlang:yield(), 446 run_test_case_msgloop(St0); 447 {abort_current_testcase,Reason,From} -> 448 Line = case is_process_alive(Pid) of 449 true -> get_loc(Pid); 450 false -> unknown 451 end, 452 Mon = erlang:monitor(process, Pid), 453 exit(Pid,{testcase_aborted,Reason,Line}), 454 erlang:yield(), 455 From ! {self(),abort_current_testcase,ok}, 456 St = receive 457 {'DOWN', Mon, process, Pid, _} -> 458 St0 459 after 10000 -> 460 %% Pid is probably trapping exits, hit it harder... 461 exit(Pid, kill), 462 %% here's the only place we know Reason, so we save 463 %% it as a comment, potentially replacing user data 464 Error = lists:flatten(io_lib:format("Aborted: ~tp", 465 [Reason])), 466 Error1 = lists:flatten([string:trim(S,leading,"\s") || 467 S <- string:lexemes(Error, 468 [$\n])]), 469 ErrorLength = string:length(Error1), 470 Comment = if ErrorLength > 63 -> 471 string:slice(Error1,0,60) ++ "..."; 472 true -> 473 Error1 474 end, 475 St0#st{comment=Comment} 476 end, 477 run_test_case_msgloop(St); 478 {sync_apply,From,MFA} -> 479 do_sync_apply(false,From,MFA), 480 run_test_case_msgloop(St0); 481 {sync_apply_proxy,Proxy,From,MFA} -> 482 do_sync_apply(Proxy,From,MFA), 483 run_test_case_msgloop(St0); 484 {comment,NewComment0} -> 485 NewComment1 = test_server_ctrl:to_string(NewComment0), 486 NewComment = test_server_sup:framework_call(format_comment, 487 [NewComment1], 488 NewComment1), 489 run_test_case_msgloop(St0#st{comment=NewComment}); 490 {read_comment,From} -> 491 From ! {self(),read_comment,St0#st.comment}, 492 run_test_case_msgloop(St0); 493 {make_priv_dir,From} -> 494 Config = case St0#st.config of 495 undefined -> []; 496 Config0 -> Config0 497 end, 498 Result = 499 case proplists:get_value(priv_dir, Config) of 500 undefined -> 501 {error,no_priv_dir_in_config}; 502 PrivDir -> 503 case file:make_dir(PrivDir) of 504 ok -> 505 ok; 506 {error, eexist} -> 507 ok; 508 MkDirError -> 509 {error,{MkDirError,PrivDir}} 510 end 511 end, 512 From ! {self(),make_priv_dir,Result}, 513 run_test_case_msgloop(St0); 514 {'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} -> 515 RetVal = {Time/1000000,Value,Loc,Opts}, 516 St = setup_termination(RetVal, St0#st{config=undefined}), 517 run_test_case_msgloop(St); 518 {'EXIT',Pid,Reason} -> 519 %% This exit typically happens when an unknown external process 520 %% has caused a test case process to terminate (e.g. if a linked 521 %% process has crashed). 522 St = 523 case Reason of 524 {What,[Loc0={_M,_F,A,[{file,_}|_]}|_]} when 525 is_integer(A) -> 526 Loc = rewrite_loc_item(Loc0), 527 handle_tc_exit(What, St0#st{last_known_loc=[Loc]}); 528 {What,[Details,Loc0={_M,_F,A,[{file,_}|_]}|_]} when 529 is_integer(A) -> 530 Loc = rewrite_loc_item(Loc0), 531 handle_tc_exit({What,Details}, St0#st{last_known_loc=[Loc]}); 532 _ -> 533 handle_tc_exit(Reason, St0) 534 end, 535 run_test_case_msgloop(St); 536 {EndConfPid0,{call_end_conf,Data,_Result}} -> 537 #st{mf={Mod,Func},config=CurrConf} = St0, 538 case CurrConf of 539 _ when is_list(CurrConf) -> 540 {_Mod,_Func,TCPid,TCExitReason,Loc} = Data, 541 spawn_fw_call(Mod,Func,CurrConf,TCPid, 542 TCExitReason,Loc,self()), 543 St = St0#st{config=undefined,end_conf_pid=undefined}, 544 run_test_case_msgloop(St); 545 _ -> 546 run_test_case_msgloop(St0) 547 end; 548 {_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} -> 549 %% the framework has been notified, we're finished 550 RetVal = {T,Value,Loc,Opts}, 551 Comment0 = St0#st.comment, 552 Comment = case AddToComment of 553 undefined -> 554 Comment0; 555 _ -> 556 if Comment0 =:= "" -> 557 AddToComment; 558 true -> 559 Comment0 ++ 560 test_server_ctrl:xhtml("<br>", 561 "<br />") ++ 562 AddToComment 563 end 564 end, 565 St = setup_termination(RetVal, St0#st{comment=Comment, 566 config=undefined}), 567 run_test_case_msgloop(St); 568 {'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} -> 569 %% a framework function failed 570 CB = os:getenv("TEST_SERVER_FRAMEWORK"), 571 Loc = case CB of 572 FW when FW =:= false; FW =:= "undefined" -> 573 [{test_server,Func}]; 574 _ -> 575 [{list_to_atom(CB),Func}] 576 end, 577 RetVal = {died,{framework_error,Loc,Error},Loc}, 578 St = setup_termination(RetVal, St0#st{comment="Framework error", 579 config=undefined}), 580 run_test_case_msgloop(St); 581 {failed,File,Line} -> 582 put(test_server_detected_fail, 583 [{File, Line}| get(test_server_detected_fail)]), 584 run_test_case_msgloop(St0); 585 586 {user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} -> 587 case update_user_timetraps(Pid, StartTime) of 588 proceed -> 589 self() ! {abort_current_testcase,E,Pid}, 590 ok; 591 ignore -> 592 ok 593 end, 594 run_test_case_msgloop(St0); 595 {user_timetrap,Pid,TrapTime,StartTime,ElapsedTime,Scale} -> 596 %% a user timetrap is triggered, ignore it if new 597 %% timetrap has been started since 598 case update_user_timetraps(Pid, StartTime) of 599 proceed -> 600 TotalTime = if is_integer(TrapTime) -> 601 TrapTime + ElapsedTime; 602 true -> 603 TrapTime 604 end, 605 _ = timetrap(TrapTime, TotalTime, Pid, Scale), 606 ok; 607 ignore -> 608 ok 609 end, 610 run_test_case_msgloop(St0); 611 {timetrap_cancel_one,Handle,_From} -> 612 timetrap_cancel_one(Handle, false), 613 run_test_case_msgloop(St0); 614 {timetrap_cancel_all,TCPid,_From} -> 615 timetrap_cancel_all(TCPid, false), 616 run_test_case_msgloop(St0); 617 {get_timetrap_info,From,TCPid} -> 618 Info = get_timetrap_info(TCPid, false), 619 From ! {self(),get_timetrap_info,Info}, 620 run_test_case_msgloop(St0); 621 _Other when not is_tuple(_Other) -> 622 %% ignore anything not generated by test server 623 run_test_case_msgloop(St0); 624 _Other when element(1, _Other) /= 'EXIT', 625 element(1, _Other) /= started, 626 element(1, _Other) /= finished, 627 element(1, _Other) /= print -> 628 %% ignore anything not generated by test server 629 run_test_case_msgloop(St0) 630 after St0#st.timeout -> 631 #st{ret_val=RetVal,comment=Comment} = St0, 632 erlang:append_element(RetVal, Comment) 633 end. 634 635setup_termination(RetVal, #st{pid=Pid}=St) -> 636 timetrap_cancel_all(Pid, false), 637 St#st{ret_val=RetVal,timeout=20}. 638 639set_tc_state(State) -> 640 set_tc_state(State,unknown). 641set_tc_state(State, Config) -> 642 tc_supervisor_req(set_tc_state, {State,Config}). 643 644handle_tc_exit(killed, St) -> 645 %% probably the result of an exit(TestCase,kill) call, which is the 646 %% only way to abort a testcase process that traps exits 647 %% (see abort_current_testcase). 648 #st{config=Config,mf={Mod,Func},pid=Pid} = St, 649 Msg = testcase_aborted_or_killed, 650 spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()), 651 St; 652handle_tc_exit({testcase_aborted,{user_timetrap_error,_}=Msg,_}, St) -> 653 #st{config=Config,mf={Mod,Func},pid=Pid} = St, 654 spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()), 655 St; 656handle_tc_exit(Reason, #st{status={framework,{FwMod,FwFunc,_}=FwMFA}, 657 config=Config,mf={Mod,Func},pid=Pid}=St) -> 658 R = case Reason of 659 {timetrap_timeout,TVal,_} -> 660 {timetrap,TVal}; 661 {testcase_aborted=E,AbortReason,_} -> 662 {E,AbortReason}; 663 {fw_error,{FwMod,FwFunc,FwError}} -> 664 FwError; 665 Other -> 666 Other 667 end, 668 Error = {framework_error,R}, 669 spawn_fw_call(Mod, Func, Config, Pid, {Error,FwMFA}, unknown, self()), 670 St; 671handle_tc_exit(Reason, #st{status=tc,config=Config0,mf={Mod,Func},pid=Pid}=St) 672 when is_list(Config0) -> 673 {R,Loc1,F} = case Reason of 674 {timetrap_timeout=E,TVal,Loc0} -> 675 {{E,TVal},Loc0,E}; 676 {testcase_aborted=E,AbortReason,Loc0} -> 677 Msg = {E,AbortReason}, 678 {Msg,Loc0,Msg}; 679 Other -> 680 {{'EXIT',Other},unknown,Other} 681 end, 682 Timeout = end_conf_timeout(Reason, St), 683 Config = [{tc_status,{failed,F}}|Config0], 684 EndConfPid = call_end_conf(Mod, Func, Pid, R, Loc1, Config, Timeout), 685 St#st{end_conf_pid=EndConfPid}; 686handle_tc_exit(Reason, #st{config=Config,mf={Mod,Func0},pid=Pid, 687 status=Status}=St) -> 688 {R,Loc1} = case Reason of 689 {timetrap_timeout=E,TVal,Loc0} -> 690 {{E,TVal},Loc0}; 691 {testcase_aborted=E,AbortReason,Loc0} -> 692 {{E,AbortReason},Loc0}; 693 Other -> 694 {{'EXIT',Other},St#st.last_known_loc} 695 end, 696 Func = case Status of 697 init_per_testcase=F -> {F,Func0}; 698 end_per_testcase=F -> {F,Func0}; 699 _ -> Func0 700 end, 701 spawn_fw_call(Mod, Func, Config, Pid, R, Loc1, self()), 702 St. 703 704end_conf_timeout({timetrap_timeout,Timeout,_}, _) -> 705 Timeout; 706end_conf_timeout(_, #st{config=Config}) when is_list(Config) -> 707 proplists:get_value(default_timeout, Config, ?DEFAULT_TIMETRAP_SECS*1000); 708end_conf_timeout(_, _) -> 709 ?DEFAULT_TIMETRAP_SECS*1000. 710 711call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) -> 712 Starter = self(), 713 Data = {Mod,Func,TCPid,TCExitReason,Loc}, 714 case erlang:function_exported(Mod,end_per_testcase,2) of 715 false -> 716 spawn_link(fun() -> 717 Starter ! {self(),{call_end_conf,Data,ok}} 718 end); 719 true -> 720 do_call_end_conf(Starter,Mod,Func,Data,TCExitReason,Conf,TVal) 721 end. 722 723do_call_end_conf(Starter,Mod,Func,Data,TCExitReason,Conf,TVal) -> 724 EndConfProc = 725 fun() -> 726 process_flag(trap_exit,true), % to catch timetraps 727 Supervisor = self(), 728 EndConfApply = 729 fun() -> 730 _ = timetrap(TVal), 731 %% We can't handle fails or skips here 732 %% (neither input nor output). The error can 733 %% be read from Conf though (tc_status). 734 EndConf = 735 case do_init_tc_call(Mod,{end_per_testcase,Func}, 736 [Conf], 737 {TCExitReason,[Conf]}) of 738 {_,[EPTCInit]} when is_list(EPTCInit) -> 739 EPTCInit; 740 _ -> 741 Conf 742 end, 743 try apply(Mod,end_per_testcase,[Func,EndConf]) of 744 _ -> ok 745 catch 746 _:Error -> 747 timer:sleep(1), 748 print_end_conf_result(Mod,Func,Conf, 749 "crashed",Error) 750 end, 751 Supervisor ! {self(),end_conf} 752 end, 753 Pid = spawn_link(EndConfApply), 754 receive 755 {Pid,end_conf} -> 756 Starter ! {self(),{call_end_conf,Data,ok}}; 757 {'EXIT',Pid,Reason} -> 758 print_end_conf_result(Mod,Func,Conf,"failed",Reason), 759 Starter ! {self(),{call_end_conf,Data,{error,Reason}}}; 760 {'EXIT',_OtherPid,Reason} -> 761 %% Probably the parent - not much to do about that 762 exit(Reason) 763 end 764 end, 765 spawn_link(EndConfProc). 766 767print_end_conf_result(Mod,Func,Conf,Cause,Error) -> 768 Str2Print = 769 fun(NoHTML) when NoHTML == stdout; NoHTML == major -> 770 io_lib:format("WARNING! " 771 "~w:end_per_testcase(~tw, ~tp)" 772 " ~s!\n\tReason: ~tp\n", 773 [Mod,Func,Conf,Cause,Error]); 774 (minor) -> 775 ErrorStr = test_server_ctrl:escape_chars(Error), 776 io_lib:format("WARNING! " 777 "~w:end_per_testcase(~tw, ~tp)" 778 " ~s!\n\tReason: ~ts\n", 779 [Mod,Func,Conf,Cause,ErrorStr]) 780 end, 781 group_leader() ! {printout,12,Str2Print}, 782 ok. 783 784 785spawn_fw_call(Mod,IPTC={init_per_testcase,Func},CurrConf,Pid, 786 Why,Loc,SendTo) -> 787 FwCall = 788 fun() -> 789 ct_util:mark_process(), 790 Skip = {skip,{failed,{Mod,init_per_testcase,Why}}}, 791 %% if init_per_testcase fails, the test case 792 %% should be skipped 793 try begin do_end_tc_call(Mod,IPTC, {Pid,Skip,[CurrConf]}, Why), 794 do_init_tc_call(Mod,{end_per_testcase_not_run,Func}, 795 [CurrConf],{ok,[CurrConf]}), 796 do_end_tc_call(Mod,{end_per_testcase_not_run,Func}, 797 {Pid,Skip,[CurrConf]}, Why) end of 798 _ -> ok 799 catch 800 _:FwEndTCErr -> 801 exit({fw_notify_done,end_tc,FwEndTCErr}) 802 end, 803 Time = case Why of 804 {timetrap_timeout,TVal} -> TVal/1000; 805 _ -> died 806 end, 807 group_leader() ! {printout,12, 808 "ERROR! ~w:init_per_testcase(~tw, ~tp)" 809 " failed!\n\tReason: ~tp\n", 810 [Mod,Func,CurrConf,Why]}, 811 %% finished, report back 812 SendTo ! {self(),fw_notify_done,{Time,Skip,Loc,[],undefined}} 813 end, 814 spawn_link(FwCall); 815 816spawn_fw_call(Mod,EPTC={end_per_testcase,Func},EndConf,Pid, 817 Why,_Loc,SendTo) -> 818 FwCall = 819 fun() -> 820 ct_util:mark_process(), 821 {RetVal,Report} = 822 case proplists:get_value(tc_status, EndConf) of 823 undefined -> 824 E = {failed,{Mod,end_per_testcase,Why}}, 825 {E,E}; 826 E = {failed,Reason} -> 827 {E,{error,Reason}}; 828 Result -> 829 E = {failed,{Mod,end_per_testcase,Why}}, 830 {Result,E} 831 end, 832 {Time,Warn} = 833 case Why of 834 {timetrap_timeout,TVal} -> 835 group_leader() ! 836 {printout,12, 837 "WARNING! ~w:end_per_testcase(~tw, ~tp)" 838 " failed!\n\tReason: timetrap timeout" 839 " after ~w ms!\n", [Mod,Func,EndConf,TVal]}, 840 W = "<font color=\"red\">" 841 "WARNING: end_per_testcase timed out!</font>", 842 {TVal/1000,W}; 843 _ -> 844 group_leader() ! 845 {printout,12, 846 "WARNING! ~w:end_per_testcase(~tw, ~tp)" 847 " failed!\n\tReason: ~tp\n", 848 [Mod,Func,EndConf,Why]}, 849 W = "<font color=\"red\">" 850 "WARNING: end_per_testcase failed!</font>", 851 {died,W} 852 end, 853 FailLoc0 = proplists:get_value(tc_fail_loc, EndConf), 854 {RetVal1,FailLoc} = 855 try do_end_tc_call(Mod,EPTC,{Pid,Report,[EndConf]}, Why) of 856 Why -> 857 {RetVal,FailLoc0}; 858 {failed,_} = R -> 859 {R,[{Mod,Func}]}; 860 R -> 861 {R,FailLoc0} 862 catch 863 _:FwEndTCErr -> 864 exit({fw_notify_done,end_tc,FwEndTCErr}) 865 end, 866 %% finished, report back (if end_per_testcase fails, a warning 867 %% should be printed as part of the comment) 868 SendTo ! {self(),fw_notify_done, 869 {Time,RetVal1,FailLoc,[],Warn}} 870 end, 871 spawn_link(FwCall); 872 873spawn_fw_call(Mod,Func,Conf,Pid,{{framework_error,FwError}, 874 {FwMod,FwFunc,[A1,A2|_]}=FwMFA},_,SendTo) -> 875 FwCall = 876 fun() -> 877 ct_util:mark_process(), 878 Time = 879 case FwError of 880 {timetrap,TVal} -> 881 TVal/1000; 882 _ -> 883 died 884 end, 885 {Ret,Loc,WarnOrError} = 886 cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,FwMFA), 887 Comment = 888 case WarnOrError of 889 warn -> 890 group_leader() ! 891 {printout,12, 892 "WARNING! ~w:~tw(~w,~tw,...) failed!\n" 893 " Reason: ~tp\n", 894 [FwMod,FwFunc,A1,A2,FwError]}, 895 lists:flatten( 896 io_lib:format("<font color=\"red\">" 897 "WARNING! ~w:~tw(~w,~tw,...) " 898 "failed!</font>", 899 [FwMod,FwFunc,A1,A2])); 900 error -> 901 group_leader() ! 902 {printout,12, 903 "Error! ~w:~tw(~w,~tw,...) failed!\n" 904 " Reason: ~tp\n", 905 [FwMod,FwFunc,A1,A2,FwError]}, 906 lists:flatten( 907 io_lib:format("<font color=\"red\">" 908 "ERROR! ~w:~tw(~w,~tw,...) " 909 "failed!</font>", 910 [FwMod,FwFunc,A1,A2])) 911 end, 912 %% finished, report back 913 SendTo ! {self(),fw_notify_done, 914 {Time,Ret,Loc,[],Comment}} 915 end, 916 spawn_link(FwCall); 917 918spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> 919 ct_util:mark_process(), 920 {Func1,EndTCFunc} = case Func of 921 CF when CF == init_per_suite; CF == end_per_suite; 922 CF == init_per_group; CF == end_per_group -> 923 {CF,CF}; 924 TC -> {TC,{end_per_testcase,TC}} 925 end, 926 FwCall = 927 fun() -> 928 try fw_error_notify(Mod,Func1,[], 929 Error,Loc) of 930 _ -> ok 931 catch 932 _:FwErrorNotifyErr -> 933 exit({fw_notify_done,error_notification, 934 FwErrorNotifyErr}) 935 end, 936 Conf = [{tc_status,{failed,Error}}|CurrConf], 937 {Time,RetVal,Loc1} = 938 try do_end_tc_call(Mod,EndTCFunc,{Pid,Error,[Conf]},Error) of 939 Error -> 940 {died, Error, Loc}; 941 {failed,Reason} = NewReturn -> 942 fw_error_notify(Mod,Func1,Conf,Reason), 943 {died, NewReturn, [{Mod,Func}]}; 944 NewReturn -> 945 T = case Error of 946 {timetrap_timeout,TT} -> TT; 947 _ -> 0 948 end, 949 {T, NewReturn, Loc} 950 catch 951 _:FwEndTCErr -> 952 exit({fw_notify_done,end_tc,FwEndTCErr}) 953 end, 954 %% finished, report back 955 SendTo ! {self(),fw_notify_done,{Time,RetVal,Loc1,[],undefined}} 956 end, 957 spawn_link(FwCall). 958 959cleanup_after_fw_error(_Mod,_Func,Conf,Pid,FwError, 960 {FwMod,FwFunc=init_tc, 961 [Mod,{init_per_testcase,Func}=IPTC|_]}) -> 962 %% Failed during pre_init_per_testcase, the test must be skipped 963 Skip = {auto_skip,{failed,{FwMod,FwFunc,FwError}}}, 964 try begin do_end_tc_call(Mod,IPTC, {Pid,Skip,[Conf]}, FwError), 965 do_init_tc_call(Mod,{end_per_testcase_not_run,Func}, 966 [Conf],{ok,[Conf]}), 967 do_end_tc_call(Mod,{end_per_testcase_not_run,Func}, 968 {Pid,Skip,[Conf]}, FwError) end of 969 _ -> ok 970 catch 971 _:FwEndTCErr -> 972 exit({fw_notify_done,end_tc,FwEndTCErr}) 973 end, 974 {Skip,{FwMod,FwFunc},error}; 975cleanup_after_fw_error(_Mod,_Func,Conf,Pid,FwError, 976 {FwMod,FwFunc=end_tc,[Mod,{init_per_testcase,Func}|_]}) -> 977 %% Failed during post_init_per_testcase, the test must be skipped 978 Skip = {auto_skip,{failed,{FwMod,FwFunc,FwError}}}, 979 try begin do_init_tc_call(Mod,{end_per_testcase_not_run,Func}, 980 [Conf],{ok,[Conf]}), 981 do_end_tc_call(Mod,{end_per_testcase_not_run,Func}, 982 {Pid,Skip,[Conf]}, FwError) end of 983 _ -> ok 984 catch 985 _:FwEndTCErr -> 986 exit({fw_notify_done,end_tc,FwEndTCErr}) 987 end, 988 {Skip,{FwMod,FwFunc},error}; 989cleanup_after_fw_error(_Mod,_Func,Conf,Pid,FwError, 990 {FwMod,FwFunc=init_tc,[Mod,{end_per_testcase,Func}|_]}) -> 991 %% Failed during pre_end_per_testcase. Warn about it. 992 {RetVal,Loc} = 993 case {proplists:get_value(tc_status, Conf), 994 proplists:get_value(tc_fail_loc, Conf, unknown)} of 995 {undefined,_} -> 996 {{failed,{FwMod,FwFunc,FwError}},{FwMod,FwFunc}}; 997 {E = {failed,_Reason},unknown} -> 998 {E,[{Mod,Func}]}; 999 {Result,FailLoc} -> 1000 {Result,FailLoc} 1001 end, 1002 try begin do_end_tc_call(Mod,{end_per_testcase_not_run,Func}, 1003 {Pid,RetVal,[Conf]}, FwError) end of 1004 _ -> ok 1005 catch 1006 _:FwEndTCErr -> 1007 exit({fw_notify_done,end_tc,FwEndTCErr}) 1008 end, 1009 {RetVal,Loc,warn}; 1010cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError, 1011 {FwMod,FwFunc=end_tc,[Mod,{end_per_testcase,Func}|_]}) -> 1012 %% Failed during post_end_per_testcase. Warn about it. 1013 {RetVal,Report,Loc} = 1014 case {proplists:get_value(tc_status, Conf), 1015 proplists:get_value(tc_fail_loc, Conf, unknown)} of 1016 {undefined,_} -> 1017 {{failed,{FwMod,FwFunc,FwError}}, 1018 {{FwMod,FwError},FwError}, 1019 {FwMod,FwFunc}}; 1020 {E = {failed,_Reason},unknown} -> 1021 {E,{Mod,Func,E},[{Mod,Func}]}; 1022 {Result,FailLoc} -> 1023 {Result,{Mod,Func,Result},FailLoc} 1024 end, 1025 try begin do_end_tc_call(Mod,{cleanup,{end_per_testcase_not_run,Func}}, 1026 {Pid,RetVal,[Conf]}, FwError) end of 1027 _ -> ok 1028 catch 1029 _:FwEndTCErr -> 1030 exit({fw_notify_done,end_tc,FwEndTCErr}) 1031 end, 1032 test_server_sup:framework_call(report,[framework_error,Report]), 1033 {RetVal,Loc,warn}; 1034cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=init_tc,_}) 1035 when Func =:= init_per_suite; Func =:=init_per_group -> 1036 %% Failed during pre_init_per_suite or pre_init_per_group 1037 RetVal = {failed,{FwMod,FwFunc,FwError}}, 1038 try do_end_tc_call(Mod,Func,{Pid,RetVal,[Conf]},FwError) of 1039 _ -> ok 1040 catch 1041 _:FwEndTCErr -> 1042 exit({fw_notify_done,end_tc,FwEndTCErr}) 1043 end, 1044 {RetVal,{FwMod,FwFunc},error}; 1045cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=end_tc,_}) 1046 when Func =:= init_per_suite; Func =:=init_per_group -> 1047 %% Failed during post_init_per_suite or post_init_per_group 1048 RetVal = {failed,{FwMod,FwFunc,FwError}}, 1049 try do_end_tc_call(Mod,{cleanup,Func},{Pid,RetVal,[Conf]},FwError) of 1050 _ -> ok 1051 catch 1052 _:FwEndTCErr -> 1053 exit({fw_notify_done,end_tc,FwEndTCErr}) 1054 end, 1055 ReportFunc = 1056 case Func of 1057 init_per_group -> 1058 case proplists:get_value(tc_group_properties,Conf) of 1059 undefined -> 1060 {Func,unknown,[]}; 1061 GProps -> 1062 Name = proplists:get_value(name,GProps), 1063 {Func,Name,proplists:delete(name,GProps)} 1064 end; 1065 _ -> 1066 Func 1067 end, 1068 test_server_sup:framework_call(report,[framework_error, 1069 {Mod,ReportFunc,RetVal}]), 1070 {RetVal,{FwMod,FwFunc},error}; 1071cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=init_tc,_}) 1072 when Func =:= end_per_suite; Func =:=end_per_group -> 1073 %% Failed during pre_end_per_suite or pre_end_per_group 1074 RetVal = {failed,{FwMod,FwFunc,FwError}}, 1075 try do_end_tc_call(Mod,Func,{Pid,RetVal,[Conf]},FwError) of 1076 _ -> ok 1077 catch 1078 _:FwEndTCErr -> 1079 exit({fw_notify_done,end_tc,FwEndTCErr}) 1080 end, 1081 {RetVal,{FwMod,FwFunc},error}; 1082cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=end_tc,_}) 1083 when Func =:= end_per_suite; Func =:=end_per_group -> 1084 %% Failed during post_end_per_suite or post_end_per_group 1085 RetVal = {failed,{FwMod,FwFunc,FwError}}, 1086 try do_end_tc_call(Mod,{cleanup,Func},{Pid,RetVal,[Conf]},FwError) of 1087 _ -> ok 1088 catch 1089 _:FwEndTCErr -> 1090 exit({fw_notify_done,end_tc,FwEndTCErr}) 1091 end, 1092 ReportFunc = 1093 case Func of 1094 end_per_group -> 1095 case proplists:get_value(tc_group_properties,Conf) of 1096 undefined -> 1097 {Func,unknown,[]}; 1098 GProps -> 1099 Name = proplists:get_value(name,GProps), 1100 {Func,Name,proplists:delete(name,GProps)} 1101 end; 1102 _ -> 1103 Func 1104 end, 1105 test_server_sup:framework_call(report,[framework_error, 1106 {Mod,ReportFunc,RetVal}]), 1107 {RetVal,{FwMod,FwFunc},error}; 1108cleanup_after_fw_error(_Mod,_Func,_Conf,_Pid,FwError,{FwMod,FwFunc,_}) -> 1109 %% This is unexpected 1110 test_server_sup:framework_call(report, 1111 [framework_error, 1112 {{FwMod,FwFunc}, 1113 FwError}]), 1114 {FwError,{FwMod,FwFunc},error}. 1115 1116%% The job proxy process forwards messages between the test case 1117%% process on a shielded node (and its descendants) and the job process. 1118%% 1119%% The job proxy process have to be started by the test-case process 1120%% on the shielded node! 1121start_job_proxy() -> 1122 group_leader(spawn(fun () -> job_proxy_msgloop() end), self()), ok. 1123 1124%% The io_reply_proxy is not the most satisfying solution but it works... 1125io_reply_proxy(ReplyTo) -> 1126 ct_util:mark_process(), 1127 receive 1128 IoReply when is_tuple(IoReply), 1129 element(1, IoReply) == io_reply -> 1130 ReplyTo ! IoReply; 1131 _ -> 1132 io_reply_proxy(ReplyTo) 1133 end. 1134 1135job_proxy_msgloop() -> 1136 ct_util:mark_process(), 1137 receive 1138 1139 %% 1140 %% Messages that need intervention by proxy... 1141 %% 1142 1143 %% io stuff ... 1144 IoReq when tuple_size(IoReq) >= 2, 1145 element(1, IoReq) == io_request -> 1146 1147 ReplyProxy = spawn(fun () -> io_reply_proxy(element(2, IoReq)) end), 1148 group_leader() ! setelement(2, IoReq, ReplyProxy); 1149 1150 %% test_server stuff... 1151 {sync_apply, From, MFA} -> 1152 group_leader() ! {sync_apply_proxy, self(), From, MFA}; 1153 {sync_result_proxy, To, Result} -> 1154 To ! {sync_result, Result}; 1155 1156 %% 1157 %% Messages that need no intervention by proxy... 1158 %% 1159 Msg -> 1160 group_leader() ! Msg 1161 end, 1162 job_proxy_msgloop(). 1163 1164-spec run_test_case_eval_fun(_, _, _, _, _, _, _, _, _) -> 1165 fun(() -> no_return()). 1166run_test_case_eval_fun(Mod, Func, Args, Name, Ref, RunInit, 1167 TimetrapData, LogOpts, TCCallback) -> 1168 fun () -> 1169 run_test_case_eval(Mod, Func, Args, Name, Ref, 1170 RunInit, TimetrapData, 1171 LogOpts, TCCallback) 1172 end. 1173 1174%% A test case is known to have failed if it returns {'EXIT', _} tuple, 1175%% or sends a message {failed, File, Line} to it's group_leader 1176 1177run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, 1178 TimetrapData, LogOpts, TCCallback) -> 1179 put(test_server_multiply_timetraps, TimetrapData), 1180 put(test_server_logopts, LogOpts), 1181 Where = [{Mod,Func}], 1182 put(test_server_loc, Where), 1183 1184 FWInitFunc = case RunInit of 1185 run_init -> {init_per_testcase,Func}; 1186 _ -> Func 1187 end, 1188 1189 FWInitResult0 = do_init_tc_call(Mod,FWInitFunc,Args0,{ok,Args0}), 1190 1191 set_tc_state(running), 1192 {{Time,Value},Loc,Opts} = 1193 case FWInitResult0 of 1194 {ok,Args} -> 1195 run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback); 1196 Error = {error,_Reason} -> 1197 NewResult = do_end_tc_call(Mod,FWInitFunc, {Error,Args0}, 1198 {auto_skip,{failed,Error}}), 1199 {{0,NewResult},Where,[]}; 1200 {fail,Reason} -> 1201 Conf = [{tc_status,{failed,Reason}} | hd(Args0)], 1202 fw_error_notify(Mod, Func, Conf, Reason), 1203 NewResult = do_end_tc_call(Mod,FWInitFunc, 1204 {{error,Reason},[Conf]}, 1205 {fail,Reason}), 1206 {{0,NewResult},Where,[]}; 1207 Skip = {SkipType,_Reason} when SkipType == skip; 1208 SkipType == skipped -> 1209 NewResult = do_end_tc_call(Mod,FWInitFunc, 1210 {Skip,Args0}, Skip), 1211 {{0,NewResult},Where,[]}; 1212 AutoSkip = {auto_skip,_Reason} -> 1213 %% special case where a conf case "pretends" to be skipped 1214 NewResult = 1215 do_end_tc_call(Mod,FWInitFunc, {AutoSkip,Args0}, AutoSkip), 1216 {{0,NewResult},Where,[]} 1217 end, 1218 exit({Ref,Time,Value,Loc,Opts}). 1219 1220run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> 1221 case RunInit of 1222 run_init -> 1223 set_tc_state(init_per_testcase, hd(Args)), 1224 ensure_timetrap(Args), 1225 case init_per_testcase(Mod, Func, Args) of 1226 Skip = {SkipType,Reason} when SkipType == skip; 1227 SkipType == skipped -> 1228 Line = get_loc(), 1229 Conf = [{tc_status,{skipped,Reason}}|hd(Args)], 1230 NewRes = do_end_tc_call(Mod,{init_per_testcase,Func}, 1231 {Skip,[Conf]}, Skip), 1232 {{0,NewRes},Line,[]}; 1233 {skip_and_save,Reason,SaveCfg} -> 1234 Line = get_loc(), 1235 Conf = [{tc_status,{skipped,Reason}}, 1236 {save_config,SaveCfg}|hd(Args)], 1237 NewRes = do_end_tc_call(Mod,{init_per_testcase,Func}, 1238 {{skip,Reason},[Conf]}, 1239 {skip,Reason}), 1240 {{0,NewRes},Line,[]}; 1241 FailTC = {fail,Reason} -> % user fails the testcase 1242 EndConf = [{tc_status,{failed,Reason}} | hd(Args)], 1243 fw_error_notify(Mod, Func, EndConf, Reason), 1244 NewRes = do_end_tc_call(Mod,{init_per_testcase,Func}, 1245 {{error,Reason},[EndConf]}, 1246 FailTC), 1247 {{0,NewRes},[{Mod,Func}],[]}; 1248 {ok,NewConf} -> 1249 IPTCEndRes = do_end_tc_call(Mod,{init_per_testcase,Func}, 1250 {ok,[NewConf]}, NewConf), 1251 {{T,Return},Loc,NewConf1} = 1252 if not is_list(IPTCEndRes) -> 1253 %% received skip or fail, not config 1254 {{0,IPTCEndRes},undefined,NewConf}; 1255 true -> 1256 %% call user callback function if defined 1257 NewConfUC = 1258 user_callback(TCCallback, Mod, Func, 1259 init, IPTCEndRes), 1260 %% save current state in controller loop 1261 set_tc_state(tc, NewConfUC), 1262 %% execute the test case 1263 {ts_tc(Mod,Func,[NewConfUC]),get_loc(),NewConfUC} 1264 end, 1265 {EndConf,TSReturn,FWReturn} = 1266 case Return of 1267 {E,TCError} when E=='EXIT' ; E==failed -> 1268 fw_error_notify(Mod, Func, NewConf1, 1269 TCError, Loc), 1270 {[{tc_status,{failed,TCError}}, 1271 {tc_fail_loc,Loc}|NewConf1], 1272 Return,{error,TCError}}; 1273 SaveCfg={save_config,_} -> 1274 {[{tc_status,ok},SaveCfg|NewConf1],Return,ok}; 1275 {skip_and_save,Why,SaveCfg} -> 1276 Skip = {skip,Why}, 1277 {[{tc_status,{skipped,Why}}, 1278 {save_config,SaveCfg}|NewConf1], 1279 Skip,Skip}; 1280 {SkipType,Why} when SkipType == skip; 1281 SkipType == skipped -> 1282 {[{tc_status,{skipped,Why}}|NewConf1],Return, 1283 Return}; 1284 _ -> 1285 {[{tc_status,ok}|NewConf1],Return,ok} 1286 end, 1287 %% call user callback function if defined 1288 EndConf1 = 1289 user_callback(TCCallback, Mod, Func, 'end', EndConf), 1290 1291 %% save updated config in controller loop 1292 set_tc_state(tc, EndConf1), 1293 1294 %% We can't handle fails or skips here 1295 EndConf2 = 1296 case do_init_tc_call(Mod,{end_per_testcase,Func}, 1297 [EndConf1],{ok,[EndConf1]}) of 1298 {ok,[EPTCInitRes]} when is_list(EPTCInitRes) -> 1299 EPTCInitRes; 1300 _ -> 1301 EndConf1 1302 end, 1303 1304 %% update current state in controller loop 1305 {FWReturn1,TSReturn1,EndConf3} = 1306 case end_per_testcase(Mod, Func, EndConf2) of 1307 SaveCfg1={save_config,_} -> 1308 {FWReturn,TSReturn, 1309 [SaveCfg1|lists:keydelete(save_config,1, 1310 EndConf2)]}; 1311 {fail,ReasonToFail} -> 1312 %% user has failed the testcase 1313 fw_error_notify(Mod, Func, EndConf2, 1314 ReasonToFail), 1315 {{error,ReasonToFail}, 1316 {failed,ReasonToFail}, 1317 EndConf2}; 1318 {failed,{_,end_per_testcase,_}} = Failure when 1319 FWReturn == ok -> 1320 %% unexpected termination in end_per_testcase 1321 %% report this as the result to the framework 1322 {Failure,TSReturn,EndConf2}; 1323 _ -> 1324 %% test case result should be reported to 1325 %% framework no matter the status of 1326 %% end_per_testcase 1327 {FWReturn,TSReturn,EndConf2} 1328 end, 1329 %% clear current state in controller loop 1330 case do_end_tc_call(Mod,{end_per_testcase,Func}, 1331 {FWReturn1,[EndConf3]}, TSReturn1) of 1332 {failed,Reason} = NewReturn -> 1333 fw_error_notify(Mod,Func,EndConf3, Reason), 1334 {{T,NewReturn},[{Mod,Func}],[]}; 1335 NewReturn -> 1336 {{T,NewReturn},Loc,[]} 1337 end 1338 end; 1339 skip_init -> 1340 set_tc_state(running, hd(Args)), 1341 %% call user callback function if defined 1342 Args1 = user_callback(TCCallback, Mod, Func, init, Args), 1343 ensure_timetrap(Args1), 1344 %% ts_tc does a catch 1345 %% if this is a named conf group, the test case (init or end conf) 1346 %% should be called with the name as the first argument 1347 Args2 = if Name == undefined -> Args1; 1348 true -> [Name | Args1] 1349 end, 1350 %% execute the conf test case 1351 {{T,Return},Loc} = {ts_tc(Mod, Func, Args2),get_loc()}, 1352 %% call user callback function if defined 1353 Return1 = user_callback(TCCallback, Mod, Func, 'end', Return), 1354 {Return2,Opts} = process_return_val([Return1], Mod, Func, 1355 Args1, [{Mod,Func}], Return1), 1356 {{T,Return2},Loc,Opts} 1357 end. 1358 1359do_init_tc_call(Mod, Func, Res, Return) -> 1360 test_server_sup:framework_call(init_tc,[Mod,Func,Res],Return). 1361 1362do_end_tc_call(Mod, IPTC={init_per_testcase,Func}, Res, Return) -> 1363 case Return of 1364 {NOk,_} when NOk == auto_skip; NOk == fail; 1365 NOk == skip ; NOk == skipped -> 1366 {_,Args} = Res, 1367 {NewConfig,IPTCEndRes} = 1368 case do_end_tc_call1(Mod, IPTC, Res, Return) of 1369 IPTCEndConfig when is_list(IPTCEndConfig) -> 1370 {IPTCEndConfig,IPTCEndConfig}; 1371 {failed,RetReason} when Return=:={fail,RetReason} -> 1372 %% Fail reason not changed by framework or hook 1373 {Args,Return}; 1374 {SF,_} = IPTCEndResult when SF=:=skip; SF=:=skipped; 1375 SF=:=fail; SF=:=failed -> 1376 {Args,IPTCEndResult}; 1377 _ -> 1378 {Args,Return} 1379 end, 1380 EPTCInitRes = 1381 case do_init_tc_call(Mod,{end_per_testcase_not_run,Func}, 1382 NewConfig,IPTCEndRes) of 1383 {ok,EPTCInitConfig} when is_list(EPTCInitConfig) -> 1384 {IPTCEndRes,EPTCInitConfig}; 1385 _ -> 1386 {IPTCEndRes,NewConfig} 1387 end, 1388 do_end_tc_call1(Mod, {end_per_testcase_not_run,Func}, 1389 EPTCInitRes, IPTCEndRes); 1390 _Ok -> 1391 do_end_tc_call1(Mod, IPTC, Res, Return) 1392 end; 1393do_end_tc_call(Mod, Func, Res, Return) -> 1394 do_end_tc_call1(Mod, Func, Res, Return). 1395 1396do_end_tc_call1(Mod, Func, Res, Return) -> 1397 FwMod = os:getenv("TEST_SERVER_FRAMEWORK"), 1398 Ref = make_ref(), 1399 if FwMod == "ct_framework" ; FwMod == "undefined"; FwMod == false -> 1400 case test_server_sup:framework_call( 1401 end_tc, [Mod,Func,Res, Return], ok) of 1402 {fail,FWReason} -> 1403 {failed,FWReason}; 1404 ok -> 1405 case Return of 1406 {fail,Reason} -> 1407 {failed,Reason}; 1408 Return -> 1409 Return 1410 end; 1411 NewReturn -> 1412 NewReturn 1413 end; 1414 true -> 1415 case test_server_sup:framework_call(FwMod, end_tc, 1416 [Mod,Func,Res], Ref) of 1417 {fail,FWReason} -> 1418 {failed,FWReason}; 1419 _Else -> 1420 Return 1421 end 1422 end. 1423 1424%% the return value is a list and we have to check if it contains 1425%% the result of an end conf case or if it's a Config list 1426process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) -> 1427 ReturnTags = [skip,skip_and_save,save_config,comment,return_group_result], 1428 %% check if all elements in the list are valid end conf return value tuples 1429 case lists:all(fun(Val) when is_tuple(Val) -> 1430 lists:any(fun(T) -> T == element(1, Val) end, 1431 ReturnTags); 1432 (ok) -> 1433 true; 1434 (_) -> 1435 false 1436 end, Return) of 1437 true -> % must be return value from end conf case 1438 process_return_val1(Return, M,F,A, Loc, Final, []); 1439 false -> % must be Config value from init conf case 1440 case do_end_tc_call(M, F, {ok,A}, Return) of 1441 {failed, FWReason} = Failed -> 1442 fw_error_notify(M,F,A, FWReason), 1443 {Failed, []}; 1444 NewReturn -> 1445 {NewReturn, []} 1446 end 1447 end; 1448%% the return value is not a list, so it's the return value from an 1449%% end conf case or it's a dummy value that can be ignored 1450process_return_val(Return, M,F,A, Loc, Final) -> 1451 process_return_val1(Return, M,F,A, Loc, Final, []). 1452 1453process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts) 1454 when E=='EXIT'; 1455 E==failed -> 1456 fw_error_notify(M,F,A, TCError, Loc), 1457 case do_end_tc_call(M,F, {{error,TCError}, 1458 [[{tc_status,{failed,TCError}}|Args]]}, 1459 Failed) of 1460 {failed,FWReason} -> 1461 {{failed,FWReason},SaveOpts}; 1462 NewReturn -> 1463 {NewReturn,SaveOpts} 1464 end; 1465process_return_val1([SaveCfg={save_config,_}|Opts], M,F,[Args], 1466 Loc, Final, SaveOpts) -> 1467 process_return_val1(Opts, M,F,[[SaveCfg|Args]], Loc, Final, SaveOpts); 1468process_return_val1([{skip_and_save,Why,SaveCfg}|Opts], M,F,[Args], 1469 Loc, _, SaveOpts) -> 1470 process_return_val1(Opts, M,F,[[{save_config,SaveCfg}|Args]], 1471 Loc, {skip,Why}, SaveOpts); 1472process_return_val1([GR={return_group_result,_}|Opts], M,F,A, 1473 Loc, Final, SaveOpts) -> 1474 process_return_val1(Opts, M,F,A, Loc, Final, [GR|SaveOpts]); 1475process_return_val1([RetVal={Tag,_}|Opts], M,F,A, 1476 Loc, _, SaveOpts) when Tag==skip; 1477 Tag==comment -> 1478 process_return_val1(Opts, M,F,A, Loc, RetVal, SaveOpts); 1479process_return_val1([_|Opts], M,F,A, Loc, Final, SaveOpts) -> 1480 process_return_val1(Opts, M,F,A, Loc, Final, SaveOpts); 1481process_return_val1([], M,F,A, _Loc, Final, SaveOpts) -> 1482 case do_end_tc_call(M,F, {Final,A}, Final) of 1483 {failed,FWReason} -> 1484 {{failed,FWReason},SaveOpts}; 1485 NewReturn -> 1486 {NewReturn,lists:reverse(SaveOpts)} 1487 end. 1488 1489user_callback(undefined, _, _, _, Args) -> 1490 Args; 1491user_callback({CBMod,CBFunc}, Mod, Func, InitOrEnd, 1492 [Args]) when is_list(Args) -> 1493 case catch apply(CBMod, CBFunc, [InitOrEnd,Mod,Func,Args]) of 1494 Args1 when is_list(Args1) -> 1495 [Args1]; 1496 _ -> 1497 [Args] 1498 end; 1499user_callback({CBMod,CBFunc}, Mod, Func, InitOrEnd, Args) -> 1500 case catch apply(CBMod, CBFunc, [InitOrEnd,Mod,Func,Args]) of 1501 Args1 when is_list(Args1) -> 1502 Args1; 1503 _ -> 1504 Args 1505 end. 1506 1507init_per_testcase(Mod, Func, Args) -> 1508 case code:is_loaded(Mod) of 1509 false -> 1510 _ = code:load_file(Mod), 1511 ok; 1512 _ -> ok 1513 end, 1514 case erlang:function_exported(Mod, init_per_testcase, 2) of 1515 true -> 1516 do_init_per_testcase(Mod, [Func|Args]); 1517 false -> 1518 %% Optional init_per_testcase is not defined -- keep quiet. 1519 [Config] = Args, 1520 {ok, Config} 1521 end. 1522 1523do_init_per_testcase(Mod, Args) -> 1524 try apply(Mod, init_per_testcase, Args) of 1525 {Skip,Reason} when Skip =:= skip; Skip =:= skipped -> 1526 {skip,Reason}; 1527 {skip_and_save,_,_}=Res -> 1528 Res; 1529 NewConf when is_list(NewConf) -> 1530 case lists:filter(fun(T) when is_tuple(T) -> false; 1531 (_) -> true end, NewConf) of 1532 [] -> 1533 {ok,NewConf}; 1534 Bad -> 1535 group_leader() ! {printout,12, 1536 "ERROR! init_per_testcase has returned " 1537 "bad elements in Config: ~tp\n",[Bad]}, 1538 {skip,{failed,{Mod,init_per_testcase,bad_return}}} 1539 end; 1540 {fail,_Reason}=Res -> 1541 Res; 1542 _Other -> 1543 group_leader() ! {printout,12, 1544 "ERROR! init_per_testcase did not return " 1545 "a Config list.\n",[]}, 1546 {skip,{failed,{Mod,init_per_testcase,bad_return}}} 1547 catch 1548 throw:{Skip,Reason} when Skip =:= skip; Skip =:= skipped -> 1549 {skip,Reason}; 1550 exit:{Skip,Reason} when Skip =:= skip; Skip =:= skipped -> 1551 {skip,Reason}; 1552 throw:Other:Stk -> 1553 set_loc(Stk), 1554 Line = get_loc(), 1555 print_init_conf_result(Line,"thrown",Other), 1556 {skip,{failed,{Mod,init_per_testcase,Other}}}; 1557 _:Reason0:Stk -> 1558 Reason = {Reason0,Stk}, 1559 set_loc(Stk), 1560 Line = get_loc(), 1561 print_init_conf_result(Line,"crashed",Reason), 1562 {skip,{failed,{Mod,init_per_testcase,Reason}}} 1563 end. 1564 1565print_init_conf_result(Line,Cause,Reason) -> 1566 FormattedLoc = test_server_sup:format_loc(Line), 1567 Str2Print = 1568 fun(NoHTML) when NoHTML == stdout; NoHTML == major -> 1569 io_lib:format("ERROR! init_per_testcase ~s!\n" 1570 "\tLocation: ~tp\n\tReason: ~tp\n", 1571 [Cause,Line,Reason]); 1572 (minor) -> 1573 ReasonStr = test_server_ctrl:escape_chars(Reason), 1574 io_lib:format("ERROR! init_per_testcase ~s!\n" 1575 "\tLocation: ~ts\n\tReason: ~ts\n", 1576 [Cause,FormattedLoc,ReasonStr]) 1577 end, 1578 group_leader() ! {printout,12,Str2Print}, 1579 ok. 1580 1581 1582end_per_testcase(Mod, Func, Conf) -> 1583 case erlang:function_exported(Mod,end_per_testcase,2) of 1584 true -> 1585 do_end_per_testcase(Mod,end_per_testcase,Func,Conf); 1586 false -> 1587 %% Backwards compatibility! 1588 case erlang:function_exported(Mod,fin_per_testcase,2) of 1589 true -> 1590 do_end_per_testcase(Mod,fin_per_testcase,Func,Conf); 1591 false -> 1592 ok 1593 end 1594 end. 1595 1596do_end_per_testcase(Mod,EndFunc,Func,Conf) -> 1597 set_tc_state(end_per_testcase, Conf), 1598 try Mod:EndFunc(Func, Conf) of 1599 {save_config,_}=SaveCfg -> 1600 SaveCfg; 1601 {fail,_}=Fail -> 1602 Fail; 1603 _ -> 1604 ok 1605 catch 1606 throw:Other:Stk -> 1607 Comment0 = case read_comment() of 1608 "" -> ""; 1609 Cmt -> Cmt ++ test_server_ctrl:xhtml("<br>", 1610 "<br />") 1611 end, 1612 set_loc(Stk), 1613 comment(io_lib:format("~ts<font color=\"red\">" 1614 "WARNING: ~w thrown!" 1615 "</font>\n",[Comment0,EndFunc])), 1616 print_end_tc_warning(EndFunc,Other,"thrown",get_loc()), 1617 {failed,{Mod,end_per_testcase,Other}}; 1618 Class:Reason:Stk -> 1619 set_loc(Stk), 1620 Why = case Class of 1621 exit -> {'EXIT',Reason}; 1622 error -> {'EXIT',{Reason,Stk}} 1623 end, 1624 Comment0 = case read_comment() of 1625 "" -> ""; 1626 Cmt -> Cmt ++ test_server_ctrl:xhtml("<br>", 1627 "<br />") 1628 end, 1629 comment(io_lib:format("~ts<font color=\"red\">" 1630 "WARNING: ~w crashed!" 1631 "</font>\n",[Comment0,EndFunc])), 1632 print_end_tc_warning(EndFunc,Reason,"crashed",get_loc()), 1633 {failed,{Mod,end_per_testcase,Why}} 1634 end. 1635 1636print_end_tc_warning(EndFunc,Reason,Cause,Loc) -> 1637 FormattedLoc = test_server_sup:format_loc(Loc), 1638 Str2Print = 1639 fun(NoHTML) when NoHTML == stdout; NoHTML == major -> 1640 io_lib:format("WARNING: ~w ~s!\n" 1641 "Reason: ~tp\nLine: ~tp\n", 1642 [EndFunc,Cause,Reason,Loc]); 1643 (minor) -> 1644 ReasonStr = test_server_ctrl:escape_chars(Reason), 1645 io_lib:format("WARNING: ~w ~s!\n" 1646 "Reason: ~ts\nLine: ~ts\n", 1647 [EndFunc,Cause,ReasonStr,FormattedLoc]) 1648 end, 1649 group_leader() ! {printout,12,Str2Print}, 1650 ok. 1651 1652get_loc() -> 1653 get(test_server_loc). 1654 1655get_loc(Pid) -> 1656 [{current_stacktrace,Stk0},{dictionary,Dict}] = 1657 process_info(Pid, [current_stacktrace,dictionary]), 1658 lists:foreach(fun({Key,Val}) -> put(Key, Val) end, Dict), 1659 Stk = [rewrite_loc_item(Loc) || Loc <- Stk0], 1660 case get(test_server_loc) of 1661 [{Suite,Case}] -> 1662 %% Location info unknown, check if {Suite,Case,Line} 1663 %% is available in stacktrace and if so, use stacktrace 1664 %% instead of current test_server_loc. 1665 %% If location is the last expression in a test case 1666 %% function, the info is not available due to tail call 1667 %% elimination. We need to check if the test case has been 1668 %% called by ts_tc/3 and, if so, insert the test case info 1669 %% at that position. 1670 case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of 1671 [match|_] -> 1672 put(test_server_loc, Stk); 1673 _ -> 1674 {PreTC,PostTC} = 1675 lists:splitwith(fun({test_server,ts_tc,_}) -> 1676 false; 1677 (_) -> 1678 true 1679 end, Stk), 1680 if PostTC == [] -> 1681 ok; 1682 true -> 1683 put(test_server_loc, 1684 PreTC++[{Suite,Case,last_expr} | PostTC]) 1685 end 1686 end; 1687 _ -> 1688 put(test_server_loc, Stk) 1689 end, 1690 get_loc(). 1691 1692fw_error_notify(Mod, Func, Args, Error) -> 1693 test_server_sup:framework_call(error_notification, 1694 [Mod,Func,[Args], 1695 {Error,unknown}]). 1696fw_error_notify(Mod, Func, Args, Error, Loc) -> 1697 test_server_sup:framework_call(error_notification, 1698 [Mod,Func,[Args], 1699 {Error,Loc}]). 1700 1701%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1702 1703%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1704%% print(Detail,Format,Args,Printer) -> ok 1705%% Detail = integer() 1706%% Format = string() 1707%% Args = [term()] 1708%% 1709%% Just like io:format, except that depending on the Detail value, the output 1710%% is directed to console, major and/or minor log files. 1711 1712%% print(Detail,Format,Args) -> 1713%% test_server_ctrl:print(Detail, Format, Args). 1714 1715print(Detail,Format,Args,Printer) -> 1716 test_server_ctrl:print(Detail, Format, Args, Printer). 1717 1718%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1719%% print_timsteamp(Detail,Leader) -> ok 1720%% 1721%% Prints Leader followed by a time stamp (date and time). Depending on 1722%% the Detail value, the output is directed to console, major and/or minor 1723%% log files. 1724 1725print_timestamp(Detail,Leader) -> 1726 test_server_ctrl:print_timestamp(Detail, Leader). 1727 1728 1729%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1730%% lookup_config(Key,Config) -> {value,{Key,Value}} | undefined 1731%% Key = term() 1732%% Value = term() 1733%% Config = [{Key,Value},...] 1734%% 1735%% Looks up a specific key in the config list, and returns the value 1736%% of the associated key, or undefined if the key doesn't exist. 1737 1738lookup_config(Key,Config) -> 1739 case lists:keysearch(Key,1,Config) of 1740 {value,{Key,Val}} -> 1741 Val; 1742 _ -> 1743 io:format("Could not find element ~tp in Config.~n",[Key]), 1744 undefined 1745 end. 1746 1747%% 1748%% IMPORTANT: get_loc/1 uses the name of this function when analysing 1749%% stack traces. If the name changes, get_loc/1 must be updated! 1750%% 1751ts_tc(M, F, A) -> 1752 Before = erlang:monotonic_time(), 1753 Result = try 1754 apply(M, F, A) 1755 catch 1756 throw:{skip, Reason} -> {skip, Reason}; 1757 throw:{skipped, Reason} -> {skip, Reason}; 1758 exit:{skip, Reason} -> {skip, Reason}; 1759 exit:{skipped, Reason} -> {skip, Reason}; 1760 Type:Reason:Stk -> 1761 set_loc(Stk), 1762 case Type of 1763 throw -> 1764 {failed,{thrown,Reason}}; 1765 error -> 1766 {'EXIT',{Reason,Stk}}; 1767 exit -> 1768 {'EXIT',Reason} 1769 end 1770 end, 1771 After = erlang:monotonic_time(), 1772 Elapsed = erlang:convert_time_unit(After-Before, native, micro_seconds), 1773 {Elapsed, Result}. 1774 1775set_loc(Stk) -> 1776 Loc = case [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk] of 1777 [{M,F,0}|Stack] -> 1778 [{M,F}|Stack]; 1779 Other -> 1780 Other 1781 end, 1782 put(test_server_loc, Loc). 1783 1784rewrite_loc_item({M,F,_,Loc}) -> 1785 {M,F,proplists:get_value(line, Loc, 0)}. 1786 1787%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1788 1789%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1790%% TEST SUITE SUPPORT FUNCTIONS %% 1791%% %% 1792%% Note: Some of these functions have been moved to test_server_sup %% 1793%% in an attempt to keep this modules small (yeah, right!) %% 1794%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1795 1796%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1797%% format(Format) -> IoLibReturn 1798%% format(Detail,Format) -> IoLibReturn 1799%% format(Format,Args) -> IoLibReturn 1800%% format(Detail,Format,Args) -> IoLibReturn 1801%% Detail = integer() 1802%% Format = string() 1803%% Args = [term(),...] 1804%% IoLibReturn = term() 1805%% 1806%% Logs the Format string and Args, similar to io:format/1/2 etc. If 1807%% Detail is not specified, the default detail level (which is 50) is used. 1808%% Which log files the string will be logged in depends on the thresholds 1809%% set with set_levels/3. Typically with default detail level, only the 1810%% minor log file is used. 1811format(Format) -> 1812 format(minor, Format, []). 1813 1814format(major, Format) -> 1815 format(major, Format, []); 1816format(minor, Format) -> 1817 format(minor, Format, []); 1818format(Detail, Format) when is_integer(Detail) -> 1819 format(Detail, Format, []); 1820format(Format, Args) -> 1821 format(minor, Format, Args). 1822 1823format(Detail, Format, Args) -> 1824 Str = 1825 case catch io_lib:format(Format,Args) of 1826 {'EXIT',_} -> 1827 io_lib:format("illegal format; ~tp with args ~tp.\n", 1828 [Format,Args]); 1829 Valid -> Valid 1830 end, 1831 log({Detail, Str}). 1832 1833log(Msg) -> 1834 group_leader() ! {structured_io, self(), Msg}, 1835 ok. 1836 1837%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1838%% capture_start() -> ok 1839%% capture_stop() -> ok 1840%% 1841%% Starts/stops capturing all output from io:format, and similar. Capturing 1842%% output doesn't stop output from happening. It just makes it possible 1843%% to retrieve the output using capture_get/0. 1844%% Starting and stopping capture doesn't affect already captured output. 1845%% All output is stored as messages in the message queue until retrieved 1846 1847capture_start() -> 1848 group_leader() ! {capture,self()}, 1849 ok. 1850 1851capture_stop() -> 1852 group_leader() ! {capture,false}, 1853 ok. 1854 1855%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1856%% capture_get() -> Output 1857%% Output = [string(),...] 1858%% 1859%% Retrieves all the captured output since last call to capture_get/0. 1860%% Note that since output arrive as messages to the process, it takes 1861%% a short while from the call to io:format until all output is available 1862%% by capture_get/0. It is not necessary to call capture_stop/0 before 1863%% retreiving the output. 1864capture_get() -> 1865 test_server_sup:capture_get([]). 1866 1867%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1868%% messages_get() -> Messages 1869%% Messages = [term(),...] 1870%% 1871%% Returns all messages in the message queue. 1872messages_get() -> 1873 test_server_sup:messages_get([]). 1874 1875%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1876%% permit_io(GroupLeader, FromPid) -> ok 1877%% 1878%% Make sure proceeding IO from FromPid won't get rejected 1879permit_io(GroupLeader, FromPid) -> 1880 GroupLeader ! {permit_io,FromPid}, 1881 ok. 1882 1883%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1884%% sleep(Time) -> ok 1885%% Time = integer() | float() | infinity 1886%% 1887%% Sleeps the specified number of milliseconds. This sleep also accepts 1888%% floating point numbers (which are truncated) and the atom 'infinity'. 1889sleep(infinity) -> 1890 receive 1891 after infinity -> 1892 ok 1893 end; 1894sleep(MSecs) -> 1895 receive 1896 after trunc(MSecs) -> 1897 ok 1898 end, 1899 ok. 1900 1901%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1902%% adjusted_sleep(Time) -> ok 1903%% Time = integer() | float() | infinity 1904%% 1905%% Sleeps the specified number of milliseconds, multiplied by the 1906%% 'multiply_timetraps' value (if set) and possibly also automatically scaled 1907%% up if 'scale_timetraps' is set to true (which is default). 1908%% This function also accepts floating point numbers (which are truncated) and 1909%% the atom 'infinity'. 1910adjusted_sleep(infinity) -> 1911 receive 1912 after infinity -> 1913 ok 1914 end; 1915adjusted_sleep(MSecs) -> 1916 {Multiplier,ScaleFactor} = 1917 case test_server_ctrl:get_timetrap_parameters() of 1918 {undefined,undefined} -> 1919 {1,1}; 1920 {undefined,false} -> 1921 {1,1}; 1922 {undefined,true} -> 1923 {1,timetrap_scale_factor()}; 1924 {infinity,_} -> 1925 {infinity,1}; 1926 {Mult,undefined} -> 1927 {Mult,1}; 1928 {Mult,false} -> 1929 {Mult,1}; 1930 {Mult,true} -> 1931 {Mult,timetrap_scale_factor()} 1932 end, 1933 receive 1934 after trunc(MSecs*Multiplier*ScaleFactor) -> 1935 ok 1936 end, 1937 ok. 1938 1939%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1940%% fail(Reason) -> exit({suite_failed,Reason}) 1941%% 1942%% Immediately calls exit. Included because test suites are easier 1943%% to read when using this function, rather than exit directly. 1944fail(Reason) -> 1945 comment(cast_to_list(Reason)), 1946 try 1947 exit({suite_failed,Reason}) 1948 catch 1949 Class:R:Stacktrace -> 1950 case Stacktrace of 1951 [{?MODULE,fail,1,_}|Stk] -> ok; 1952 Stk -> ok 1953 end, 1954 erlang:raise(Class, R, Stk) 1955 end. 1956 1957cast_to_list(X) when is_list(X) -> X; 1958cast_to_list(X) when is_atom(X) -> atom_to_list(X); 1959cast_to_list(X) -> lists:flatten(io_lib:format("~tp", [X])). 1960 1961 1962 1963%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1964%% fail() -> exit(suite_failed) 1965%% 1966%% Immediately calls exit. Included because test suites are easier 1967%% to read when using this function, rather than exit directly. 1968fail() -> 1969 try 1970 exit(suite_failed) 1971 catch 1972 Class:R:Stacktrace -> 1973 case Stacktrace of 1974 [{?MODULE,fail,0,_}|Stk] -> ok; 1975 Stk -> ok 1976 end, 1977 erlang:raise(Class, R, Stk) 1978 end. 1979 1980%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1981%% break(Comment) -> ok 1982%% 1983%% Break a test case so part of the test can be done manually. 1984%% Use continue/0 to continue. 1985break(Comment) -> 1986 break(?MODULE, Comment). 1987 1988break(CBM, Comment) -> 1989 break(CBM, '', Comment). 1990 1991break(CBM, TestCase, Comment) -> 1992 timetrap_cancel(), 1993 {TCName,CntArg,PName} = 1994 if TestCase == '' -> 1995 {"", "", test_server_break_process}; 1996 true -> 1997 Str = atom_to_list(TestCase), 1998 {[32 | Str], Str, 1999 list_to_atom("test_server_break_process_" ++ Str)} 2000 end, 2001 io:format(user, 2002 "\n\n\n--- SEMIAUTOMATIC TESTING ---" 2003 "\nThe test case~ts executes on process ~w" 2004 "\n\n\n~ts" 2005 "\n\n\n-----------------------------\n\n" 2006 "Continue with --> ~w:continue(~ts).\n", 2007 [TCName,self(),Comment,CBM,CntArg]), 2008 case whereis(PName) of 2009 undefined -> 2010 spawn_break_process(self(), PName); 2011 OldBreakProcess -> 2012 OldBreakProcess ! cancel, 2013 spawn_break_process(self(), PName) 2014 end, 2015 receive continue -> ok end. 2016 2017spawn_break_process(Pid, PName) -> 2018 spawn(fun() -> 2019 register(PName, self()), 2020 ct_util:mark_process(), 2021 receive 2022 continue -> continue(Pid); 2023 cancel -> ok 2024 end 2025 end). 2026 2027continue() -> 2028 case whereis(test_server_break_process) of 2029 undefined -> ok; 2030 BreakProcess -> BreakProcess ! continue 2031 end. 2032 2033continue(TestCase) when is_atom(TestCase) -> 2034 PName = list_to_atom("test_server_break_process_" ++ 2035 atom_to_list(TestCase)), 2036 case whereis(PName) of 2037 undefined -> ok; 2038 BreakProcess -> BreakProcess ! continue 2039 end; 2040 2041continue(Pid) when is_pid(Pid) -> 2042 Pid ! continue. 2043 2044%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2045%% timetrap_scale_factor() -> Factor 2046%% 2047%% Returns the amount to scale timetraps with. 2048 2049%% {X, fun() -> check() end} <- multiply scale with X if Fun() is true 2050timetrap_scale_factor() -> 2051 timetrap_scale_factor([ 2052 { 2, fun() -> has_lock_checking() end}, 2053 { 3, fun() -> has_superfluous_schedulers() end}, 2054 { 6, fun() -> is_debug() end}, 2055 {10, fun() -> is_cover() end}, 2056 {10, fun() -> is_valgrind() end} 2057 ]). 2058 2059timetrap_scale_factor(Scales) -> 2060 %% The fun in {S, Fun} a filter input to the list comprehension 2061 lists:foldl(fun(S,O) -> O*S end, 1, [ S || {S,F} <- Scales, F()]). 2062 2063 2064%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2065%% timetrap(Timeout) -> Handle 2066%% Handle = term() 2067%% 2068%% Creates a time trap, that will kill the calling process if the 2069%% trap is not cancelled with timetrap_cancel/1, within Timeout milliseconds. 2070timetrap(Timeout) -> 2071 MultAndScale = 2072 case get(test_server_multiply_timetraps) of 2073 undefined -> {fun(T) -> T end, true}; 2074 {undefined,false} -> {fun(T) -> T end, false}; 2075 {undefined,_} -> {fun(T) -> T end, true}; 2076 {infinity,_} -> {fun(_) -> infinity end, false}; 2077 {Int,Scale} -> {fun(infinity) -> infinity; 2078 (T) -> T*Int end, Scale} 2079 end, 2080 timetrap(Timeout, Timeout, self(), MultAndScale). 2081 2082%% when the function is called from different process than 2083%% the test case, the test_server_multiply_timetraps data 2084%% is unknown and must be passed as argument 2085timetrap(Timeout, TCPid, MultAndScale) -> 2086 timetrap(Timeout, Timeout, TCPid, MultAndScale). 2087 2088timetrap(Timeout0, TimeToReport0, TCPid, MultAndScale = {Multiplier,Scale}) -> 2089 %% the time_ms call will either convert Timeout to ms or spawn a 2090 %% user timetrap which sends the result to the IO server process 2091 Timeout = time_ms(Timeout0, TCPid, MultAndScale), 2092 Timeout1 = Multiplier(Timeout), 2093 TimeToReport = if Timeout0 == TimeToReport0 -> 2094 Timeout1; 2095 true -> 2096 %% only convert to ms, don't start a 2097 %% user timetrap 2098 time_ms_check(TimeToReport0) 2099 end, 2100 cancel_default_timetrap(self() == TCPid), 2101 Handle = case Timeout1 of 2102 infinity -> 2103 infinity; 2104 _ -> 2105 spawn_link(test_server_sup,timetrap,[Timeout1,TimeToReport, 2106 Scale,TCPid]) 2107 end, 2108 2109 %% ERROR! This sets dict on IO process instead of testcase process 2110 %% if Timeout is return value from previous user timetrap!! 2111 2112 case get(test_server_timetraps) of 2113 undefined -> 2114 put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}]); 2115 List -> 2116 List1 = lists:delete({infinity,TCPid,{infinity,false}}, List), 2117 put(test_server_timetraps,[{Handle,TCPid, 2118 {TimeToReport,Scale}}|List1]) 2119 end, 2120 Handle. 2121 2122ensure_timetrap(Config) -> 2123 case get(test_server_timetraps) of 2124 [_|_] -> 2125 ok; 2126 _ -> 2127 case get(test_server_default_timetrap) of 2128 undefined -> ok; 2129 Garbage -> 2130 erase(test_server_default_timetrap), 2131 format("=== WARNING: garbage in " 2132 "test_server_default_timetrap: ~tp~n", 2133 [Garbage]) 2134 end, 2135 DTmo = case lists:keysearch(default_timeout,1,Config) of 2136 {value,{default_timeout,Tmo}} -> Tmo; 2137 _ -> ?DEFAULT_TIMETRAP_SECS 2138 end, 2139 format("=== test_server setting default " 2140 "timetrap of ~p seconds~n", 2141 [DTmo]), 2142 put(test_server_default_timetrap, timetrap(seconds(DTmo))) 2143 end. 2144 2145%% executing on IO process, no default timetrap ever set here 2146cancel_default_timetrap(false) -> 2147 ok; 2148cancel_default_timetrap(true) -> 2149 case get(test_server_default_timetrap) of 2150 undefined -> 2151 ok; 2152 TimeTrap when is_pid(TimeTrap) -> 2153 timetrap_cancel(TimeTrap), 2154 erase(test_server_default_timetrap), 2155 format("=== test_server canceled default timetrap " 2156 "since another timetrap was set~n"), 2157 ok; 2158 Garbage -> 2159 erase(test_server_default_timetrap), 2160 format("=== WARNING: garbage in " 2161 "test_server_default_timetrap: ~tp~n", 2162 [Garbage]), 2163 error 2164 end. 2165 2166time_ms({hours,N}, _, _) -> hours(N); 2167time_ms({minutes,N}, _, _) -> minutes(N); 2168time_ms({seconds,N}, _, _) -> seconds(N); 2169time_ms({Other,_N}, _, _) -> 2170 format("=== ERROR: Invalid time specification: ~tp. " 2171 "Should be seconds, minutes, or hours.~n", [Other]), 2172 exit({invalid_time_format,Other}); 2173time_ms(Ms, _, _) when is_integer(Ms) -> Ms; 2174time_ms(infinity, _, _) -> infinity; 2175time_ms(Fun, TCPid, MultAndScale) when is_function(Fun) -> 2176 time_ms_apply(Fun, TCPid, MultAndScale); 2177time_ms({M,F,A}=MFA, TCPid, MultAndScale) when is_atom(M), 2178 is_atom(F), 2179 is_list(A) -> 2180 time_ms_apply(MFA, TCPid, MultAndScale); 2181time_ms(Other, _, _) -> exit({invalid_time_format,Other}). 2182 2183time_ms_check(MFA = {M,F,A}) when is_atom(M), is_atom(F), is_list(A) -> 2184 MFA; 2185time_ms_check(Fun) when is_function(Fun) -> 2186 Fun; 2187time_ms_check(Other) -> 2188 time_ms(Other, undefined, undefined). 2189 2190time_ms_apply(Func, TCPid, MultAndScale) -> 2191 {_,GL} = process_info(TCPid, group_leader), 2192 WhoAmI = self(), % either TC or IO server 2193 T0 = erlang:monotonic_time(), 2194 UserTTSup = 2195 spawn(fun() -> 2196 user_timetrap_supervisor(Func, WhoAmI, TCPid, 2197 GL, T0, MultAndScale) 2198 end), 2199 receive 2200 {UserTTSup,infinity} -> 2201 %% remember the user timetrap so that it can be cancelled 2202 save_user_timetrap(TCPid, UserTTSup, T0), 2203 %% we need to make sure the user timetrap function 2204 %% gets time to execute and return 2205 timetrap(infinity, TCPid, MultAndScale) 2206 after 5000 -> 2207 exit(UserTTSup, kill), 2208 if WhoAmI /= GL -> 2209 exit({user_timetrap_error,time_ms_apply}); 2210 true -> 2211 format("=== ERROR: User timetrap execution failed!", []), 2212 ignore 2213 end 2214 end. 2215 2216user_timetrap_supervisor(Func, Spawner, TCPid, GL, T0, MultAndScale) -> 2217 process_flag(trap_exit, true), 2218 ct_util:mark_process(), 2219 Spawner ! {self(),infinity}, 2220 MonRef = monitor(process, TCPid), 2221 UserTTSup = self(), 2222 group_leader(GL, UserTTSup), 2223 UserTT = spawn_link(fun() -> call_user_timetrap(Func, UserTTSup) end), 2224 receive 2225 {UserTT,Result} -> 2226 demonitor(MonRef, [flush]), 2227 T1 = erlang:monotonic_time(), 2228 Elapsed = erlang:convert_time_unit(T1-T0, native, milli_seconds), 2229 try time_ms_check(Result) of 2230 TimeVal -> 2231 %% this is the new timetrap value to set (return value 2232 %% from a fun or an MFA) 2233 GL ! {user_timetrap,TCPid,TimeVal,T0,Elapsed,MultAndScale} 2234 catch _:_ -> 2235 %% when other than a legal timetrap value is returned 2236 %% which will be the normal case for user timetraps 2237 GL ! {user_timetrap,TCPid,0,T0,Elapsed,MultAndScale} 2238 end; 2239 {'EXIT',UserTT,Error} when Error /= normal -> 2240 demonitor(MonRef, [flush]), 2241 GL ! {user_timetrap,TCPid,0,T0,{user_timetrap_error,Error}, 2242 MultAndScale}; 2243 {'DOWN',MonRef,_,_,_} -> 2244 demonitor(MonRef, [flush]), 2245 exit(UserTT, kill) 2246 end. 2247 2248call_user_timetrap(Func, Sup) when is_function(Func) -> 2249 try Func() of 2250 Result -> 2251 Sup ! {self(),Result} 2252 catch _:Error:Stk -> 2253 exit({Error,Stk}) 2254 end; 2255call_user_timetrap({M,F,A}, Sup) -> 2256 try apply(M,F,A) of 2257 Result -> 2258 Sup ! {self(),Result} 2259 catch _:Error:Stk -> 2260 exit({Error,Stk}) 2261 end. 2262 2263save_user_timetrap(TCPid, UserTTSup, StartTime) -> 2264 %% save pid of user timetrap supervisor process so that 2265 %% it may be stopped even before the timetrap func has returned 2266 NewUserTT = {TCPid,{UserTTSup,StartTime}}, 2267 case get(test_server_user_timetrap) of 2268 undefined -> 2269 put(test_server_user_timetrap, [NewUserTT]); 2270 UserTTSups -> 2271 case proplists:get_value(TCPid, UserTTSups) of 2272 undefined -> 2273 put(test_server_user_timetrap, 2274 [NewUserTT | UserTTSups]); 2275 PrevTTSup -> 2276 %% remove prev user timetrap 2277 remove_user_timetrap(PrevTTSup), 2278 put(test_server_user_timetrap, 2279 [NewUserTT | proplists:delete(TCPid, 2280 UserTTSups)]) 2281 end 2282 end. 2283 2284update_user_timetraps(TCPid, StartTime) -> 2285 %% called when a user timetrap is triggered 2286 case get(test_server_user_timetrap) of 2287 undefined -> 2288 proceed; 2289 UserTTs -> 2290 case proplists:get_value(TCPid, UserTTs) of 2291 {_UserTTSup,StartTime} -> % same timetrap 2292 put(test_server_user_timetrap, 2293 proplists:delete(TCPid, UserTTs)), 2294 proceed; 2295 {OtherUserTTSup,OtherStartTime} -> 2296 case OtherStartTime - StartTime of 2297 Diff when Diff >= 0 -> 2298 ignore; 2299 _ -> 2300 exit(OtherUserTTSup, kill), 2301 put(test_server_user_timetrap, 2302 proplists:delete(TCPid, UserTTs)), 2303 proceed 2304 end; 2305 undefined -> 2306 proceed 2307 end 2308 end. 2309 2310remove_user_timetrap(TTSup) -> 2311 exit(TTSup, kill). 2312 2313%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2314%% timetrap_cancel(Handle) -> ok 2315%% Handle = term() 2316%% 2317%% Cancels a time trap. 2318timetrap_cancel(Handle) -> 2319 timetrap_cancel_one(Handle, true). 2320 2321timetrap_cancel_one(infinity, _SendToServer) -> 2322 ok; 2323timetrap_cancel_one(Handle, SendToServer) -> 2324 case get(test_server_timetraps) of 2325 undefined -> 2326 ok; 2327 [{Handle,_,_}] -> 2328 erase(test_server_timetraps); 2329 Timers -> 2330 case lists:keysearch(Handle, 1, Timers) of 2331 {value,_} -> 2332 put(test_server_timetraps, 2333 lists:keydelete(Handle, 1, Timers)); 2334 false when SendToServer == true -> 2335 group_leader() ! {timetrap_cancel_one,Handle,self()}; 2336 false -> 2337 ok 2338 end 2339 end, 2340 test_server_sup:timetrap_cancel(Handle). 2341 2342%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2343%% timetrap_cancel() -> ok 2344%% 2345%% Cancels timetrap for current test case. 2346timetrap_cancel() -> 2347 timetrap_cancel_all(self(), true). 2348 2349timetrap_cancel_all(TCPid, SendToServer) -> 2350 case get(test_server_timetraps) of 2351 undefined -> 2352 ok; 2353 Timers -> 2354 [timetrap_cancel_one(Handle, false) || 2355 {Handle,Pid,_} <- Timers, Pid == TCPid], 2356 ok 2357 end, 2358 case get(test_server_user_timetrap) of 2359 undefined -> 2360 ok; 2361 UserTTs -> 2362 case proplists:get_value(TCPid, UserTTs) of 2363 {UserTTSup,_StartTime} -> 2364 remove_user_timetrap(UserTTSup), 2365 put(test_server_user_timetrap, 2366 proplists:delete(TCPid, UserTTs)), 2367 ok; 2368 undefined -> 2369 ok 2370 end 2371 end, 2372 if SendToServer == true -> 2373 group_leader() ! {timetrap_cancel_all,TCPid,self()}, 2374 ok; 2375 true -> 2376 ok 2377 end, 2378 ok. 2379 2380%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2381%% get_timetrap_info() -> {Timeout,Scale} | undefined 2382%% 2383%% Read timetrap info for current test case 2384get_timetrap_info() -> 2385 get_timetrap_info(self(), true). 2386 2387get_timetrap_info(TCPid, SendToServer) -> 2388 case get(test_server_timetraps) of 2389 undefined -> 2390 undefined; 2391 Timers -> 2392 case [Info || {Handle,Pid,Info} <- Timers, 2393 Pid == TCPid, Handle /= infinity] of 2394 [{TVal,true}|_] -> 2395 {TVal,{true,test_server:timetrap_scale_factor()}}; 2396 [{TVal,false}|_] -> 2397 {TVal,{false,1}}; 2398 [] when SendToServer == true -> 2399 case tc_supervisor_req({get_timetrap_info,TCPid}) of 2400 {TVal,true} -> 2401 {TVal,{true,test_server:timetrap_scale_factor()}}; 2402 {TVal,false} -> 2403 {TVal,{false,1}}; 2404 Error -> 2405 Error 2406 end; 2407 [] -> 2408 undefined 2409 end 2410 end. 2411 2412%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2413%% hours(N) -> Milliseconds 2414%% minutes(N) -> Milliseconds 2415%% seconds(N) -> Milliseconds 2416%% N = integer() | float() 2417%% Milliseconds = integer() 2418%% 2419%% Transforms the named units to milliseconds. Fractions in the input 2420%% are accepted. The output is an integer. 2421hours(N) -> trunc(N * 1000 * 60 * 60). 2422minutes(N) -> trunc(N * 1000 * 60). 2423seconds(N) -> trunc(N * 1000). 2424 2425%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2426%% tc_supervisor_req(Tag) -> Result 2427%% tc_supervisor_req(Tag, Msg) -> Result 2428%% 2429 2430tc_supervisor_req(Tag) -> 2431 Pid = test_server_gl:get_tc_supervisor(group_leader()), 2432 Pid ! {Tag,self()}, 2433 receive 2434 {Pid,Tag,Result} -> 2435 Result 2436 after 5000 -> 2437 error(no_answer_from_tc_supervisor) 2438 end. 2439 2440tc_supervisor_req(Tag, Msg) -> 2441 Pid = test_server_gl:get_tc_supervisor(group_leader()), 2442 Pid ! {Tag,self(),Msg}, 2443 receive 2444 {Pid,Tag,Result} -> 2445 Result 2446 after 5000 -> 2447 error(no_answer_from_tc_supervisor) 2448 end. 2449 2450%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2451%% timecall(M,F,A) -> {Time,Val} 2452%% Time = float() 2453%% 2454%% Measures the time spent evaluating MFA. The measurement is done with 2455%% erlang:now/0, and should have pretty good accuracy on most platforms. 2456%% The function is not evaluated in a catch context. 2457timecall(M, F, A) -> 2458 test_server_sup:timecall(M,F,A). 2459 2460%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2461%% do_times(N,M,F,A) -> ok 2462%% do_times(N,Fun) -> 2463%% N = integer() 2464%% Fun = fun() -> void() 2465%% 2466%% Evaluates MFA or Fun N times, and returns ok. 2467do_times(N,M,F,A) when N>0 -> 2468 apply(M,F,A), 2469 do_times(N-1,M,F,A); 2470do_times(0,_,_,_) -> 2471 ok. 2472 2473do_times(N,Fun) when N>0 -> 2474 Fun(), 2475 do_times(N-1,Fun); 2476do_times(0,_) -> 2477 ok. 2478 2479%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2480%% m_out_of_n(M,N,Fun) -> ok | exit({m_out_of_n_failed,{R,left_to_do}}) 2481%% M = integer() 2482%% N = integer() 2483%% Fun = fun() -> void() 2484%% R = integer() 2485%% 2486%% Repeats evaluating the given function until it succeeded (didn't crash) 2487%% M times. If, after N times, M successful attempts have not been 2488%% accomplished, the process crashes with reason {m_out_of_n_failed 2489%% {R,left_to_do}}, where R indicates how many cases that remained to be 2490%% successfully completed. 2491%% 2492%% For example: 2493%% m_out_of_n(1,4,fun() -> tricky_test_case() end) 2494%% Tries to run tricky_test_case() up to 4 times, 2495%% and is happy if it succeeds once. 2496%% 2497%% m_out_of_n(7,8,fun() -> clock_sanity_check() end) 2498%% Tries running clock_sanity_check() up to 8 2499%% times and allows the function to fail once. 2500%% This might be useful if clock_sanity_check/0 2501%% is known to fail if the clock crosses an hour 2502%% boundary during the test (and the up to 8 2503%% test runs could never cross 2 boundaries) 2504m_out_of_n(0,_,_) -> 2505 ok; 2506m_out_of_n(M,0,_) -> 2507 exit({m_out_of_n_failed,{M,left_to_do}}); 2508m_out_of_n(M,N,Fun) -> 2509 case catch Fun() of 2510 {'EXIT',_} -> 2511 m_out_of_n(M,N-1,Fun); 2512 _Other -> 2513 m_out_of_n(M-1,N-1,Fun) 2514 end. 2515 2516%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2517%%call_crash(M,F,A) 2518%%call_crash(Time,M,F,A) 2519%%call_crash(Time,Crash,M,F,A) 2520%% M - atom() 2521%% F - atom() 2522%% A - [term()] 2523%% Time - integer() in milliseconds. 2524%% Crash - term() 2525%% 2526%% Spaws a new process that calls MFA. The call is considered 2527%% successful if the call crashes with the given reason (Crash), 2528%% or any other reason if Crash is not specified. 2529%% ** The call must terminate withing the given Time (defaults 2530%% to infinity), or it is considered a failure (exit with reason 2531%% 'call_crash_timeout' is generated). 2532 2533call_crash(M,F,A) -> 2534 call_crash(infinity,M,F,A). 2535call_crash(Time,M,F,A) -> 2536 call_crash(Time,any,M,F,A). 2537call_crash(Time,Crash,M,F,A) -> 2538 test_server_sup:call_crash(Time,Crash,M,F,A). 2539 2540%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2541%% start_node(SlaveName, Type, Options) -> 2542%% {ok, Slave} | {error, Reason} 2543%% 2544%% SlaveName = string(), atom(). 2545%% Type = slave | peer 2546%% Options = [{tuple(), term()}] 2547%% 2548%% OptionList is a tuplelist wich may contain one 2549%% or more of these members: 2550%% 2551%% Slave and Peer: 2552%% {remote, true} - Start the node on a remote host. If not specified, 2553%% the node will be started on the local host (with 2554%% some exceptions, for instance VxWorks, 2555%% where all nodes are started on a remote host). 2556%% {args, Arguments} - Arguments passed directly to the node. 2557%% {cleanup, false} - Nodes started with this option will not be killed 2558%% by the test server after completion of the test case 2559%% Therefore it is IMPORTANT that the USER terminates 2560%% the node!! 2561%% {erl, ReleaseList} - Use an Erlang emulator determined by ReleaseList 2562%% when starting nodes, instead of the same emulator 2563%% as the test server is running. ReleaseList is a list 2564%% of specifiers, where a specifier is either 2565%% {release, Rel}, {prog, Prog}, or 'this'. Rel is 2566%% either the name of a release, e.g., "r7a" or 2567%% 'latest'. 'this' means using the same emulator as 2568%% the test server. Prog is the name of an emulator 2569%% executable. If the list has more than one element, 2570%% one of them is picked randomly. (Only 2571%% works on Solaris and Linux, and the test 2572%% server gives warnings when it notices that 2573%% nodes are not of the same version as 2574%% itself.) 2575%% 2576%% Peer only: 2577%% {wait, false} - Don't wait for the node to be started. 2578%% {fail_on_error, false} - Returns {error, Reason} rather than failing 2579%% the test case. This option can only be used with 2580%% peer nodes. 2581%% Note that slave nodes always act as if they had 2582%% fail_on_error==false. 2583%% 2584 2585start_node(Name, Type, Options) -> 2586 lists:foreach( 2587 fun(N) -> 2588 case firstname(N) of 2589 Name -> 2590 format("=== WARNING: Trying to start node \'~w\' when node" 2591 " with same first name exists: ~w", [Name, N]); 2592 _other -> ok 2593 end 2594 end, 2595 nodes()), 2596 2597 group_leader() ! {sync_apply, 2598 self(), 2599 {test_server_ctrl,start_node,[Name,Type,Options]}}, 2600 Result = receive {sync_result,R} -> R end, 2601 2602 case Result of 2603 {ok,Node} -> 2604 2605 %% Cannot run cover on shielded node or on a node started 2606 %% by a shielded node. 2607 Cover = case is_cover(Node) of 2608 true -> 2609 proplists:get_value(start_cover,Options,true); 2610 false -> 2611 false 2612 end, 2613 2614 net_adm:ping(Node), 2615 case Cover of 2616 true -> 2617 do_cover_for_node(Node,start); 2618 _ -> 2619 ok 2620 end, 2621 {ok,Node}; 2622 {fail,Reason} -> fail(Reason); 2623 Error -> Error 2624 end. 2625 2626firstname(N) -> 2627 list_to_atom(upto($@,atom_to_list(N))). 2628 2629%% This should!!! crash if H is not member in list. 2630upto(H, [H | _T]) -> []; 2631upto(H, [X | T]) -> [X | upto(H,T)]. 2632 2633 2634%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2635%% wait_for_node(Name) -> ok | {error,timeout} 2636%% 2637%% If a node is started with the options {wait,false}, this function 2638%% can be used to wait for the node to come up from the 2639%% test server point of view (i.e. wait until it has contacted 2640%% the test server controller after startup) 2641wait_for_node(Slave) -> 2642 group_leader() ! {sync_apply, 2643 self(), 2644 {test_server_ctrl,wait_for_node,[Slave]}}, 2645 Result = receive {sync_result,R} -> R end, 2646 case Result of 2647 ok -> 2648 net_adm:ping(Slave), 2649 case is_cover(Slave) of 2650 true -> 2651 do_cover_for_node(Slave,start); 2652 _ -> 2653 ok 2654 end; 2655 _ -> 2656 ok 2657 end, 2658 Result. 2659 2660 2661%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2662%% stop_node(Name) -> true|false 2663%% 2664%% Kills a (remote) node. 2665%% Also inform test_server_ctrl so it can clean up! 2666stop_node(Slave) -> 2667 Cover = is_cover(Slave), 2668 if Cover -> do_cover_for_node(Slave,flush,false); 2669 true -> ok 2670 end, 2671 group_leader() ! {sync_apply,self(),{test_server_ctrl,stop_node,[Slave]}}, 2672 Result = receive {sync_result,R} -> R end, 2673 case Result of 2674 ok -> 2675 erlang:monitor_node(Slave, true), 2676 slave:stop(Slave), 2677 receive 2678 {nodedown, Slave} -> 2679 format(minor, "Stopped slave node: ~w", [Slave]), 2680 format(major, "=node_stop ~w", [Slave]), 2681 if Cover -> do_cover_for_node(Slave,stop,false); 2682 true -> ok 2683 end, 2684 true 2685 after 30000 -> 2686 format("=== WARNING: Node ~w does not seem to terminate.", 2687 [Slave]), 2688 erlang:monitor_node(Slave, false), 2689 receive {nodedown, Slave} -> ok after 0 -> ok end, 2690 false 2691 end; 2692 {error, _Reason} -> 2693 %% Either, the node is already dead or it was started 2694 %% with the {cleanup,false} option, or it was started 2695 %% in some other way than test_server:start_node/3 2696 format("=== WARNING: Attempt to stop a nonexisting slavenode (~w)~n" 2697 "=== Trying to kill it anyway!!!", 2698 [Slave]), 2699 case net_adm:ping(Slave)of 2700 pong -> 2701 erlang:monitor_node(Slave, true), 2702 slave:stop(Slave), 2703 receive 2704 {nodedown, Slave} -> 2705 format(minor, "Stopped slave node: ~w", [Slave]), 2706 format(major, "=node_stop ~w", [Slave]), 2707 if Cover -> do_cover_for_node(Slave,stop,false); 2708 true -> ok 2709 end, 2710 true 2711 after 30000 -> 2712 format("=== WARNING: Node ~w does not seem to terminate.", 2713 [Slave]), 2714 erlang:monitor_node(Slave, false), 2715 receive {nodedown, Slave} -> ok after 0 -> ok end, 2716 false 2717 end; 2718 pang -> 2719 if Cover -> do_cover_for_node(Slave,stop,false); 2720 true -> ok 2721 end, 2722 false 2723 end 2724 end. 2725 2726%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2727%% is_release_available(Release) -> true | false 2728%% Release -> string() 2729%% 2730%% Test if a release (such as "r10b") is available to be 2731%% started using start_node/3. 2732 2733is_release_available(Release) -> 2734 group_leader() ! {sync_apply, 2735 self(), 2736 {test_server_ctrl,is_release_available,[Release]}}, 2737 receive {sync_result,R} -> R end. 2738 2739 2740%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2741%% run_on_shielded_node(Fun, CArgs) -> term() 2742%% Fun -> function() 2743%% CArg -> list() 2744%% 2745%% 2746%% Fun is executed in a process on a temporarily created 2747%% hidden node. Communication with the job process goes 2748%% via a job proxy process on the hidden node, i.e. the 2749%% group leader of the test case process is the job proxy 2750%% process. This makes it possible to start nodes from the 2751%% hidden node that are unaware of the test server node. 2752%% Without the job proxy process all processes would have 2753%% a process residing on the test_server node as group_leader. 2754%% 2755%% Fun - Function to execute 2756%% CArg - Extra command line arguments to use when starting 2757%% the shielded node. 2758%% 2759%% If Fun is successfully executed, the result is returned. 2760%% 2761 2762run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) -> 2763 Nr = erlang:unique_integer([positive]), 2764 Name = "shielded_node-" ++ integer_to_list(Nr), 2765 Node = case start_node(Name, slave, [{args, "-hidden " ++ CArgs}]) of 2766 {ok, N} -> N; 2767 Err -> fail({failed_to_start_shielded_node, Err}) 2768 end, 2769 Master = self(), 2770 Ref = make_ref(), 2771 Slave = spawn(Node, start_job_proxy_fun(Master, Fun)), 2772 MRef = erlang:monitor(process, Slave), 2773 Slave ! Ref, 2774 receive 2775 {'DOWN', MRef, _, _, Info} -> 2776 stop_node(Node), 2777 fail(Info); 2778 {Ref, Res} -> 2779 stop_node(Node), 2780 receive 2781 {'DOWN', MRef, _, _, _} -> 2782 Res 2783 end 2784 end. 2785 2786-spec start_job_proxy_fun(_, _) -> fun(() -> no_return()). 2787start_job_proxy_fun(Master, Fun) -> 2788 fun () -> 2789 ct_util:mark_process(), 2790 _ = start_job_proxy(), 2791 receive 2792 Ref -> 2793 Master ! {Ref, Fun()}, 2794 ok 2795 end, 2796 receive after infinity -> infinity end 2797 end. 2798 2799%% Return true if Name or node() is a shielded node 2800is_shielded(Name) -> 2801 case {cast_to_list(Name),atom_to_list(node())} of 2802 {"shielded_node"++_,_} -> true; 2803 {_,"shielded_node"++_} -> true; 2804 _ -> false 2805 end. 2806 2807same_version(Name) -> 2808 ThisVersion = erlang:system_info(version), 2809 OtherVersion = rpc:call(Name, erlang, system_info, [version]), 2810 ThisVersion =:= OtherVersion. 2811 2812is_cover(Name) -> 2813 case is_cover() of 2814 true -> 2815 not is_shielded(Name) andalso same_version(Name); 2816 false -> 2817 false 2818 end. 2819 2820%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2821%% temp_name(Stem) -> string() 2822%% Stem = string() 2823%% 2824%% Create a unique file name, based on (starting with) Stem. 2825%% A filename of the form <Stem><Number> is generated, and the 2826%% function checks that that file doesn't already exist. 2827temp_name(Stem) -> 2828 Num = erlang:unique_integer([positive]), 2829 RandomName = Stem ++ integer_to_list(Num), 2830 {ok,Files} = file:list_dir(filename:dirname(Stem)), 2831 case lists:member(RandomName,Files) of 2832 true -> 2833 %% oh, already exists - bad luck. Try again. 2834 temp_name(Stem); %% recursively try again 2835 false -> 2836 RandomName 2837 end. 2838 2839%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2840%% app_test/1 2841%% 2842app_test(App) -> 2843 app_test(App, pedantic). 2844app_test(App, Mode) -> 2845 test_server_sup:app_test(App, Mode). 2846 2847%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2848%% appup_test/1 2849%% 2850appup_test(App) -> 2851 test_server_sup:appup_test(App). 2852 2853%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2854%% is_native(Mod) -> true | false 2855%% 2856%% Checks wether the module is natively compiled or not. 2857 2858is_native(Mod) -> 2859 (catch Mod:module_info(native)) =:= true. 2860 2861%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2862%% comment(String) -> ok 2863%% 2864%% The given String will occur in the comment field 2865%% of the table on the test suite result page. If 2866%% called several times, only the last comment is 2867%% printed. 2868%% comment/1 is also overwritten by the return value 2869%% {comment,Comment} or fail/1 (which prints Reason 2870%% as a comment). 2871comment(String) -> 2872 group_leader() ! {comment,String}, 2873 ok. 2874 2875%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2876%% read_comment() -> string() 2877%% 2878%% Read the current comment string stored in 2879%% state during test case execution. 2880read_comment() -> 2881 tc_supervisor_req(read_comment). 2882 2883%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2884%% make_priv_dir() -> ok 2885%% 2886%% Order test server to create the private directory 2887%% for the current test case. 2888make_priv_dir() -> 2889 tc_supervisor_req(make_priv_dir). 2890 2891%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2892%% os_type() -> OsType 2893%% 2894%% Returns the OsType of the target node. OsType is 2895%% the same as returned from os:type() 2896os_type() -> 2897 os:type(). 2898 2899 2900%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2901%% is_cover() -> boolean() 2902%% 2903%% Returns true if cover is running, else false 2904is_cover() -> 2905 case whereis(cover_server) of 2906 undefined -> false; 2907 _ -> true 2908 end. 2909 2910%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2911%% is_debug() -> boolean() 2912%% 2913%% Returns true if the emulator is debug-compiled, false otherwise. 2914is_debug() -> 2915 case catch erlang:system_info(debug_compiled) of 2916 {'EXIT', _} -> 2917 case string:find(erlang:system_info(system_version), "debug") of 2918 nomatch -> false; 2919 _ -> true 2920 end; 2921 Res -> 2922 Res 2923 end. 2924 2925%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2926%% has_lock_checking() -> boolean() 2927%% 2928%% Returns true if the emulator has lock checking enabled, false otherwise. 2929has_lock_checking() -> 2930 case catch erlang:system_info(lock_checking) of 2931 {'EXIT', _} -> false; 2932 Res -> Res 2933 end. 2934 2935%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2936%% has_superfluous_schedulers() -> boolean() 2937%% 2938%% Returns true if the emulator has more scheduler threads than logical 2939%% processors, false otherwise. 2940has_superfluous_schedulers() -> 2941 case catch {erlang:system_info(schedulers), 2942 erlang:system_info(logical_processors)} of 2943 {S, P} when is_integer(S), is_integer(P), S > P -> true; 2944 _ -> false 2945 end. 2946 2947%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2948%% is_commercial_build() -> boolean() 2949%% 2950%% Returns true if the current emulator is commercially supported. 2951%% (The emulator will not have "[source]" in its start-up message.) 2952%% We might want to do more tests on a commercial platform, for instance 2953%% ensuring that all applications have documentation). 2954is_commercial() -> 2955 case string:find(erlang:system_info(system_version), "source") of 2956 nomatch -> true; 2957 _ -> false 2958 end. 2959 2960%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2961%% is_valgrind() -> boolean() 2962%% 2963%% Returns true if valgrind is running, else false 2964is_valgrind() -> 2965 case catch erlang:system_info({valgrind, running}) of 2966 {'EXIT', _} -> false; 2967 Res -> Res 2968 end. 2969 2970%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2971%% DEBUGGER INTERFACE %% 2972%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2973%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2974 2975%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2976%% valgrind_new_leaks() -> ok 2977%% 2978%% Checks for new memory leaks if Valgrind is active. 2979valgrind_new_leaks() -> 2980 catch erlang:system_info({valgrind, memory}), 2981 ok. 2982 2983%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2984%% valgrind_format(Format, Args) -> ok 2985%% Format = string() 2986%% Args = lists() 2987%% 2988%% Outputs the formatted string to Valgrind's logfile,if Valgrind is active. 2989valgrind_format(Format, Args) -> 2990 (catch erlang:system_info({valgrind, io_lib:format(Format, Args)})), 2991 ok. 2992 2993 2994 2995%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2996%% 2997%% Apply given function and reply to caller or proxy. 2998%% 2999do_sync_apply(Proxy, From, {M,F,A}) -> 3000 Result = apply(M, F, A), 3001 if is_pid(Proxy) -> 3002 Proxy ! {sync_result_proxy,From,Result}, 3003 ok; 3004 true -> 3005 From ! {sync_result,Result}, 3006 ok 3007 end. 3008 3009start_cover() -> 3010 case cover:start() of 3011 {error, {already_started, Pid}} -> 3012 {ok, Pid}; 3013 Else -> 3014 Else 3015 end. 3016 3017