https://perl5.git.perl.org / perl5.git / blame
| Commit | Line | Data |
|---|---|---|
| adfe19db MHM |
1 | ################################################################################ |
| 2 | ## | |
| b2049988 | 3 | ## Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz. |
| adfe19db MHM |
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 | |
| b2049988 MHM |
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" | |
| adfe19db | 31 | # else |
| b2049988 | 32 | # error "cannot define IV/UV formats" |
| adfe19db MHM |
33 | # endif |
| 34 | #endif | |
| 35 | ||
| 36 | #ifndef NVef | |
| 37 | # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ | |
| 1d175cda MHM |
38 | defined(PERL_PRIfldbl) && { VERSION != 5.6.0 } |
| 39 | /* Not very likely, but let's try anyway. */ | |
| adfe19db MHM |
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 | ||
| 1d175cda MHM |
50 | =xsubs |
| 51 | ||
| 52 | void | |
| 53 | croak_NVgf(num) | |
| b2049988 MHM |
54 | NV num |
| 55 | PPCODE: | |
| 56 | Perl_croak(aTHX_ "%.20" NVgf "\n", num); | |
| 1d175cda | 57 | |
| cdb59e2e KW |
58 | #if { VERSION >= 5.004 } |
| 59 | ||
| bc4230ed P |
60 | SV * |
| 61 | sprintf_iv(iv) | |
| 62 | IV iv | |
| 63 | CODE: | |
| 64 | RETVAL = newSVpvf("XX_%" IVdf "_XX", iv); | |
| 65 | OUTPUT: | |
| 66 | RETVAL | |
| 67 | ||
| 68 | SV * | |
| 69 | sprintf_uv(uv) | |
| 70 | UV uv | |
| 71 | CODE: | |
| 72 | RETVAL = newSVpvf("XX_%" UVuf "_XX", uv); | |
| 73 | OUTPUT: | |
| 74 | RETVAL | |
| 75 | ||
| 76 | SV * | |
| 77 | sprintf_ivmax() | |
| 78 | CODE: | |
| 79 | RETVAL = newSVpvf("%" IVdf, IV_MAX); | |
| 80 | OUTPUT: | |
| 81 | RETVAL | |
| 82 | ||
| 83 | SV * | |
| 84 | sprintf_uvmax() | |
| 85 | CODE: | |
| 86 | RETVAL = newSVpvf("%" UVuf, UV_MAX); | |
| 87 | OUTPUT: | |
| 88 | RETVAL | |
| 89 | ||
| cdb59e2e KW |
90 | #endif |
| 91 | ||
| bc4230ed P |
92 | =tests plan => 5 |
| 93 | ||
| 94 | use Config; | |
| 1d175cda | 95 | |
| c8799aff | 96 | if (ivers($]) < ivers('5.004')) { |
| c6e41a0a | 97 | skip 'skip: No newSVpvf support', 5; |
| cdb59e2e KW |
98 | exit; |
| 99 | } | |
| 100 | ||
| 1d175cda MHM |
101 | my $num = 1.12345678901234567890; |
| 102 | ||
| 103 | eval { Devel::PPPort::croak_NVgf($num) }; | |
| 104 | ok($@ =~ /^1.1234567890/); | |
| bc4230ed | 105 | |
| 8154c0b1 KW |
106 | is(Devel::PPPort::sprintf_iv(-8), 'XX_-8_XX'); |
| 107 | is(Devel::PPPort::sprintf_uv(15), 'XX_15_XX'); | |
| bc4230ed P |
108 | |
| 109 | my $ivsize = $Config::Config{ivsize}; | |
| 8f62b02f CBW |
110 | if ($ivsize && ($ivsize == 4 || $ivsize == 8)) { |
| 111 | my $ivmax = ($ivsize == 4) ? '2147483647' : '9223372036854775807'; | |
| 112 | my $uvmax = ($ivsize == 4) ? '4294967295' : '18446744073709551615'; | |
| 8154c0b1 KW |
113 | is(Devel::PPPort::sprintf_ivmax(), $ivmax); |
| 114 | is(Devel::PPPort::sprintf_uvmax(), $uvmax); | |
| bc4230ed | 115 | } |
| 8f62b02f CBW |
116 | else { |
| 117 | skip 'skip: unknown ivsize', 2; | |
| 118 | } |