dist/Devel-PPPort/parts/inc/format

   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
  52 void
  53 croak_NVgf(num)
  54         NV num
  55         PPCODE:
  56                 Perl_croak(aTHX_ "%.20" NVgf "\n", num);
  57
  58 #if { VERSION >= 5.004 }
  59
  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
  90 #endif
  91
  92 =tests plan => 5
  93
  94 use Config;
  95
  96 if (ivers($]) < ivers('5.004')) {
  97     skip 'skip: No newSVpvf support', 5;
  98     exit;
  99 }
 100
 101 my $num = 1.12345678901234567890;
 102
 103 eval { Devel::PPPort::croak_NVgf($num) };
 104 ok($@ =~ /^1.1234567890/);
 105
 106 is(Devel::PPPort::sprintf_iv(-8), 'XX_-8_XX');
 107 is(Devel::PPPort::sprintf_uv(15), 'XX_15_XX');
 108
 109 my $ivsize = $Config::Config{ivsize};
 110 if ($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 }
 116 else {
 117     skip 'skip: unknown ivsize', 2;
 118 }