cpan/Devel-PPPort/parts/inc/newSVpv

   1 ################################################################################
   2 ##
   3 ##  $Revision: 6 $
   4 ##  $Author: mhx $
   5 ##  $Date: 2009/01/18 14:10:51 +0100 $
   6 ##
   7 ################################################################################
   8 ##
   9 ##  Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz.
  10 ##  Version 2.x, Copyright (C) 2001, Paul Marquess.
  11 ##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
  12 ##
  13 ##  This program is free software; you can redistribute it and/or
  14 ##  modify it under the same terms as Perl itself.
  15 ##
  16 ################################################################################
  17
  18 =provides
  19
  20 __UNDEFINED__
  21 newSVpvn_flags
  22
  23 =implementation
  24
  25 #if { VERSION < 5.6.0 }
  26 # define D_PPP_CONSTPV_ARG(x)  ((char *) (x))
  27 #else
  28 # define D_PPP_CONSTPV_ARG(x)  (x)
  29 #endif
  30
  31 __UNDEFINED__  newSVpvn(data,len)  ((data)                                              \
  32                                     ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
  33                                     : newSV(0))
  34
  35 __UNDEFINED__  newSVpvn_utf8(s, len, u)  newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
  36
  37 __UNDEFINED__  SVf_UTF8  0
  38
  39 #ifndef newSVpvn_flags
  40
  41 #if { NEED newSVpvn_flags }
  42
  43 SV *
  44 newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags)
  45 {
  46   SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
  47   SvFLAGS(sv) |= (flags & SVf_UTF8);
  48   return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
  49 }
  50
  51 #endif
  52
  53 #endif
  54
  55 =xsinit
  56
  57 #define NEED_newSVpvn_flags
  58
  59 =xsubs
  60
  61 void
  62 newSVpvn()
  63         PPCODE:
  64                 mXPUSHs(newSVpvn("test", 4));
  65                 mXPUSHs(newSVpvn("test", 2));
  66                 mXPUSHs(newSVpvn("test", 0));
  67                 mXPUSHs(newSVpvn(NULL, 2));
  68                 mXPUSHs(newSVpvn(NULL, 0));
  69                 XSRETURN(5);
  70
  71 void
  72 newSVpvn_flags()
  73         PPCODE:
  74                 XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP));
  75                 XPUSHs(newSVpvn_flags("test", 2, SVs_TEMP));
  76                 XPUSHs(newSVpvn_flags("test", 0, SVs_TEMP));
  77                 XPUSHs(newSVpvn_flags(NULL, 2, SVs_TEMP));
  78                 XPUSHs(newSVpvn_flags(NULL, 0, SVs_TEMP));
  79                 XSRETURN(5);
  80
  81 void
  82 newSVpvn_utf8()
  83         PPCODE:
  84                 XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP|SVf_UTF8));
  85                 XSRETURN(1);
  86
  87 =tests plan => 15
  88
  89 my @s = &Devel::PPPort::newSVpvn();
  90 ok(@s == 5);
  91 ok($s[0], "test");
  92 ok($s[1], "te");
  93 ok($s[2], "");
  94 ok(!defined($s[3]));
  95 ok(!defined($s[4]));
  96
  97 @s = &Devel::PPPort::newSVpvn_flags();
  98 ok(@s == 5);
  99 ok($s[0], "test");
 100 ok($s[1], "te");
 101 ok($s[2], "");
 102 ok(!defined($s[3]));
 103 ok(!defined($s[4]));
 104
 105 @s = &Devel::PPPort::newSVpvn_utf8();
 106 ok(@s == 1);
 107 ok($s[0], "test");
 108
 109 if ($] >= 5.008001) {
 110   require utf8;
 111   ok(utf8::is_utf8($s[0]));
 112 }
 113 else {
 114   skip("skip: no is_utf8()", 0);
 115 }