dist/Devel-PPPort/parts/inc/newSVpv

   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 __UNDEFINED__
  15 newSVpvn_flags
  16
  17 =implementation
  18
  19 #if { VERSION < 5.6.0 }
  20 # define D_PPP_CONSTPV_ARG(x)  ((char *) (x))
  21 #else
  22 # define D_PPP_CONSTPV_ARG(x)  (x)
  23 #endif
  24
  25 __UNDEFINED__  newSVpvn(data,len)  ((data)                                              \
  26                                     ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
  27                                     : newSV(0))
  28
  29 __UNDEFINED__  newSVpvn_utf8(s, len, u)  newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
  30
  31 __UNDEFINED__  SVf_UTF8  0
  32
  33 #ifndef newSVpvn_flags
  34 #  if defined(PERL_USE_GCC_BRACE_GROUPS)
  35 #    define newSVpvn_flags(s, len, flags)                       \
  36         ({                                                      \
  37             SV * sv = newSVpvn(D_PPP_CONSTPV_ARG(s), (len));    \
  38             SvFLAGS(sv) |= ((flags) & SVf_UTF8);                \
  39             if ((flags) & SVs_TEMP) sv = sv_2mortal(sv);        \
  40             sv;                                                 \
  41         })
  42 #  else
  43      PERL_STATIC_INLINE SV* D_PPP_newSVpvn_flags(const char *const s, const STRLEN len, const U32 flags)
  44      {
  45         dTHX;
  46         SV * sv = newSVpvn(s, len);
  47         SvFLAGS(sv) |= (flags & SVf_UTF8);
  48         if (flags & SVs_TEMP) return sv_2mortal(sv);
  49         return sv;
  50      }
  51 #    define newSVpvn_flags(s, len, flags) D_PPP_newSVpvn_flags((s), (len), (flags))
  52 #  endif
  53 #endif
  54
  55 =xsubs
  56
  57 void
  58 newSVpvn()
  59         PPCODE:
  60                 mXPUSHs(newSVpvn("test", 4));
  61                 mXPUSHs(newSVpvn("test", 2));
  62                 mXPUSHs(newSVpvn("test", 0));
  63                 mXPUSHs(newSVpvn(NULL, 2));
  64                 mXPUSHs(newSVpvn(NULL, 0));
  65                 XSRETURN(5);
  66
  67 void
  68 newSVpvn_flags()
  69         PPCODE:
  70                 XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP));
  71                 XPUSHs(newSVpvn_flags("test", 2, SVs_TEMP));
  72                 XPUSHs(newSVpvn_flags("test", 0, SVs_TEMP));
  73                 XPUSHs(newSVpvn_flags(NULL, 2, SVs_TEMP));
  74                 XPUSHs(newSVpvn_flags(NULL, 0, SVs_TEMP));
  75                 XSRETURN(5);
  76
  77 void
  78 newSVpvn_utf8()
  79         PPCODE:
  80                 XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP|SVf_UTF8));
  81                 XSRETURN(1);
  82
  83 =tests plan => 15
  84
  85 my @s = &Devel::PPPort::newSVpvn();
  86 ok(@s == 5);
  87 is($s[0], "test");
  88 is($s[1], "te");
  89 is($s[2], "");
  90 ok(!defined($s[3]));
  91 ok(!defined($s[4]));
  92
  93 @s = &Devel::PPPort::newSVpvn_flags();
  94 ok(@s == 5);
  95 is($s[0], "test");
  96 is($s[1], "te");
  97 is($s[2], "");
  98 ok(!defined($s[3]));
  99 ok(!defined($s[4]));
 100
 101 @s = &Devel::PPPort::newSVpvn_utf8();
 102 ok(@s == 1);
 103 is($s[0], "test");
 104
 105 if (ivers($]) >= ivers("5.008001")) {
 106   require utf8;
 107   ok(utf8::is_utf8($s[0]));
 108 }
 109 else {
 110   skip("skip: no is_utf8()", 1);
 111 }