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(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
  35 # define newSVpvn_flags(s, len, flags) ({ SV *_sv = newSVpvn(D_PPP_CONSTPV_ARG((s)), (len)); SvFLAGS(_sv) |= ((flags) & SVf_UTF8); ((flags) & SVs_TEMP) ? sv_2mortal(_sv) : _sv; })
  36 #else
  37 # define newSVpvn_flags(s, len, flags) ((PL_Sv = newSVpvn(D_PPP_CONSTPV_ARG((s)), (len))), SvFLAGS(PL_Sv) |= ((flags) & SVf_UTF8), (((flags) & SVs_TEMP) ? sv_2mortal(PL_Sv) : PL_Sv))
  38 #endif
  39 #endif
  40
  41 =xsubs
  42
  43 void
  44 newSVpvn()
  45         PPCODE:
  46                 mXPUSHs(newSVpvn("test", 4));
  47                 mXPUSHs(newSVpvn("test", 2));
  48                 mXPUSHs(newSVpvn("test", 0));
  49                 mXPUSHs(newSVpvn(NULL, 2));
  50                 mXPUSHs(newSVpvn(NULL, 0));
  51                 XSRETURN(5);
  52
  53 void
  54 newSVpvn_flags()
  55         PPCODE:
  56                 XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP));
  57                 XPUSHs(newSVpvn_flags("test", 2, SVs_TEMP));
  58                 XPUSHs(newSVpvn_flags("test", 0, SVs_TEMP));
  59                 XPUSHs(newSVpvn_flags(NULL, 2, SVs_TEMP));
  60                 XPUSHs(newSVpvn_flags(NULL, 0, SVs_TEMP));
  61                 XSRETURN(5);
  62
  63 void
  64 newSVpvn_utf8()
  65         PPCODE:
  66                 XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP|SVf_UTF8));
  67                 XSRETURN(1);
  68
  69 =tests plan => 15
  70
  71 my @s = &Devel::PPPort::newSVpvn();
  72 ok(@s == 5);
  73 is($s[0], "test");
  74 is($s[1], "te");
  75 is($s[2], "");
  76 ok(!defined($s[3]));
  77 ok(!defined($s[4]));
  78
  79 @s = &Devel::PPPort::newSVpvn_flags();
  80 ok(@s == 5);
  81 is($s[0], "test");
  82 is($s[1], "te");
  83 is($s[2], "");
  84 ok(!defined($s[3]));
  85 ok(!defined($s[4]));
  86
  87 @s = &Devel::PPPort::newSVpvn_utf8();
  88 ok(@s == 1);
  89 is($s[0], "test");
  90
  91 if ("$]" >= 5.008001) {
  92   require utf8;
  93   ok(utf8::is_utf8($s[0]));
  94 }
  95 else {
  96   skip("skip: no is_utf8()", 1);
  97 }