1################################################################################
2##
3##  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
4##  Version 2.x, Copyright (C) 2001, Paul Marquess.
5##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
6##
7##  This program is free software; you can redistribute it and/or
8##  modify it under the same terms as Perl itself.
9##
10################################################################################
11
12=provides
13
14/^#\s*define\s+(\w+)/
15
16=implementation
17
18#ifndef IVdf
19#  if IVSIZE == LONGSIZE
20#    define     IVdf      "ld"
21#    define     UVuf      "lu"
22#    define     UVof      "lo"
23#    define     UVxf      "lx"
24#    define     UVXf      "lX"
25#  elif IVSIZE == INTSIZE
26#    define   IVdf      "d"
27#    define   UVuf      "u"
28#    define   UVof      "o"
29#    define   UVxf      "x"
30#    define   UVXf      "X"
31#  else
32#    error "cannot define IV/UV formats"
33#  endif
34#endif
35
36#ifndef NVef
37#  if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
38      defined(PERL_PRIfldbl) && { VERSION != 5.6.0 }
39            /* Not very likely, but let's try anyway. */
40#    define NVef          PERL_PRIeldbl
41#    define NVff          PERL_PRIfldbl
42#    define NVgf          PERL_PRIgldbl
43#  else
44#    define NVef          "e"
45#    define NVff          "f"
46#    define NVgf          "g"
47#  endif
48#endif
49
50=xsubs
51
52void
53croak_NVgf(num)
54        NV num
55        PPCODE:
56                Perl_croak(aTHX_ "%.20" NVgf "\n", num);
57
58#if { VERSION >= 5.004 }
59
60SV *
61sprintf_iv(iv)
62        IV iv
63CODE:
64        RETVAL = newSVpvf("XX_%" IVdf "_XX", iv);
65OUTPUT:
66        RETVAL
67
68SV *
69sprintf_uv(uv)
70        UV uv
71CODE:
72        RETVAL = newSVpvf("XX_%" UVuf "_XX", uv);
73OUTPUT:
74        RETVAL
75
76SV *
77sprintf_ivmax()
78CODE:
79        RETVAL = newSVpvf("%" IVdf, IV_MAX);
80OUTPUT:
81        RETVAL
82
83SV *
84sprintf_uvmax()
85CODE:
86        RETVAL = newSVpvf("%" UVuf, UV_MAX);
87OUTPUT:
88        RETVAL
89
90#endif
91
92=tests plan => 5
93
94use Config;
95
96if (ivers($]) < ivers('5.004')) {
97    skip 'skip: No newSVpvf support', 5;
98    exit;
99}
100
101my $num = 1.12345678901234567890;
102
103eval { Devel::PPPort::croak_NVgf($num) };
104ok($@ =~ /^1.1234567890/);
105
106is(Devel::PPPort::sprintf_iv(-8), 'XX_-8_XX');
107is(Devel::PPPort::sprintf_uv(15), 'XX_15_XX');
108
109my $ivsize = $Config::Config{ivsize};
110if ($ivsize && ($ivsize == 4 || $ivsize == 8)) {
111    my $ivmax = ($ivsize == 4) ? '2147483647' : '9223372036854775807';
112    my $uvmax = ($ivsize == 4) ? '4294967295' : '18446744073709551615';
113    is(Devel::PPPort::sprintf_ivmax(), $ivmax);
114    is(Devel::PPPort::sprintf_uvmax(), $uvmax);
115}
116else {
117    skip 'skip: unknown ivsize', 2;
118}
119