line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
/* vi: set ft=c : */ |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
static void S_croaksv_from_caller(pTHX_ SV *msg_sv) |
4
|
|
|
|
|
|
|
__attribute__noreturn__; |
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
|
|
|
static void S_croaksv_from_caller(pTHX_ SV *msg_sv) |
7
|
|
|
|
|
|
|
{ |
8
|
|
|
|
|
|
|
I32 count = 0; |
9
|
|
|
|
|
|
|
const PERL_CONTEXT *cx; |
10
|
2
|
50
|
|
|
|
|
while((cx = caller_cx(count, NULL))) { |
11
|
|
|
|
|
|
|
count++; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
/* TODO: Skip internal call frames? */ |
14
|
|
|
|
|
|
|
/* warn("TODO: maybe croak from caller where caller stash is %s\n", |
15
|
|
|
|
|
|
|
* HvNAME(CopSTASH(cx->blk_oldcop))); |
16
|
|
|
|
|
|
|
*/ |
17
|
2
|
|
|
|
|
|
PL_curcop = cx->blk_oldcop; |
18
|
2
|
|
|
|
|
|
break; |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
2
|
|
|
|
|
|
croak_sv(msg_sv); |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
#define croak_from_caller(fmt, ...) S_croak_from_caller(aTHX_ fmt, __VA_ARGS__) |
25
|
|
|
|
|
|
|
static void S_croak_from_caller(pTHX_ const char *fmt, ...) |
26
|
|
|
|
|
|
|
__attribute__noreturn__; |
27
|
|
|
|
|
|
|
|
28
|
2
|
|
|
|
|
|
static void S_croak_from_caller(pTHX_ const char *fmt, ...) |
29
|
|
|
|
|
|
|
{ |
30
|
|
|
|
|
|
|
va_list args; |
31
|
2
|
|
|
|
|
|
va_start(args, fmt); |
32
|
2
|
|
|
|
|
|
SV *msg_sv = sv_2mortal(vnewSVpvf(fmt, &args)); |
33
|
2
|
|
|
|
|
|
va_end(args); |
34
|
|
|
|
|
|
|
|
35
|
2
|
|
|
|
|
|
S_croaksv_from_caller(aTHX_ msg_sv); |
36
|
|
|
|
|
|
|
} |