1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
/* vi: set ft=c : */
/* We'd like to call Perl_do_ncmp, except that isn't an exported API function
* Here's a near-copy of it */
#define sv_numcmp(left, right) S_sv_numcmp(aTHX_ left, right)
static int S_sv_numcmp(pTHX_ SV *left, SV *right)
{
#ifndef HAVE_BOOL_SvIV_please_nomg
/* Before perl 5.18, SvIV_please_nomg() was void-returning */
SvIV_please_nomg(left);
SvIV_please_nomg(right);
#endif
if(
#ifdef HAVE_BOOL_SvIV_please_nomg
SvIV_please_nomg(right) && SvIV_please_nomg(left)
#else
SvIOK(left) && SvIOK(right)
#endif
) {
/* Compare as integers */
switch((SvUOK(left) ? 1 : 0) | (SvUOK(right) ? 2 : 0)) {
case 0: /* IV == IV */
{
const IV liv = SvIVX(left), riv = SvIVX(right);
if (liv < riv) return -1;
else if(liv > riv) return 1;
else return 0;
}
case 1: /* UV == IV */
{
const IV riv = SvUVX(right);
if(riv < 0)
return 1;
const IV liv = SvIVX(left);
if (liv < riv) return -1;
else if(liv > riv) return 1;
else return 0;
}
case 2: /* IV == UV */
{
const IV liv = SvUVX(left);
if(liv < 0)
return -1;
const IV riv = SvIVX(right);
if (liv < riv) return -1;
else if(liv > riv) return 1;
else return 0;
}
case 3: /* UV == UV */
{
const UV luv = SvUVX(left), ruv = SvUVX(right);
if (luv < ruv) return -1;
else if(luv > ruv) return 1;
else return 0;
}
}
}
else {
/* Compare NVs */
NV const rnv = SvNV_nomg(right);
NV const lnv = SvNV_nomg(left);
if (lnv < rnv) return -1;
else if(lnv > rnv) return 1;
else return 0;
}
}
|
