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