- replace SvPV(,na) with SvPV_nolen()

Absolight · May 23, 2007 · 72e5aa2 · 72e5aa2
1 parent 27fcc6d
commit 72e5aa2
Show file tree

Hide file tree

Showing 12 changed files with 50 additions and 47 deletions.
diff --git a/AbstractMenu.c b/AbstractMenu.c
@@ -241,7 +241,7 @@ AbstractMenu_new_menu( Handle self, SV * sv, int level)
                            holder = av_fetch( item, num, 0);                   \
                            if ( holder) {                                      \
 			      if ( SvTYPE(*holder) != SVt_NULL) {              \
-				 l_ = duplicate_string( SvPV( *holder, na));   \
+				 l_ = duplicate_string( SvPV_nolen( *holder)); \
 				 fl_ = SvUTF8(*holder) ? 1 : 0;                \
 			      }                                                \
                            } else {                                            \
@@ -259,7 +259,7 @@ AbstractMenu_new_menu( Handle self, SV * sv, int level)
             my-> dispose_menu( self, m);
             return nil;
          }
-         r-> key = key_normalize( SvPV( *holder, na));
+         r-> key = key_normalize( SvPV_nolen( *holder));
       }
 
       if ( r-> variable)
@@ -317,7 +317,7 @@ AbstractMenu_new_menu( Handle self, SV * sv, int level)
             SvREFCNT_inc( SvRV(( PObject( r-> bitmap))-> mate));
          } else {
          TEXT:
-            r-> text = duplicate_string( SvPV( subItem, na));
+            r-> text = duplicate_string( SvPV_nolen( subItem));
             r-> flags. utf8_text = SvUTF8( subItem) ? 1 : 0;
          }
       }
@@ -349,7 +349,7 @@ AbstractMenu_new_menu( Handle self, SV * sv, int level)
             }
          } else {
             if ( SvPOK( subItem)) {
-               r-> perlSub = duplicate_string( SvPV( subItem, na));
+               r-> perlSub = duplicate_string( SvPV_nolen( subItem));
                r-> flags. utf8_perlSub = SvUTF8( subItem) ? 1 : 0;
             } else {
                warn("RTC0038: menu build error: invalid sub name passed");
@@ -646,7 +646,7 @@ AbstractMenu_accel( Handle self, Bool set, char * varName, SV * accel)
    }
    if ( m-> text == nil) return nilSV;
    free( m-> accel);
-   m-> accel = duplicate_string( SvPV( accel, na));
+   m-> accel = duplicate_string( SvPV_nolen( accel));
    m-> flags. utf8_accel = SvUTF8( accel) ? 1 : 0;
 
    if ( m-> id > 0)
@@ -686,7 +686,7 @@ AbstractMenu_action( Handle self, Bool set, char * varName, SV * action)
       }
       m-> flags. utf8_perlSub = 0;
    } else {
-      char * line = ( char *) SvPV( action, na);
+      char * line = ( char *) SvPV_nolen( action);
       free( m-> perlSub);
       if ( m-> code) sv_free( m-> code);
       m-> code = nil;
@@ -795,7 +795,7 @@ AbstractMenu_text( Handle self, Bool set, char * varName, SV * text)
       return sv;
    }
    free( m-> text);
-   m-> text = duplicate_string( SvPV( text, na));
+   m-> text = duplicate_string( SvPV_nolen( text));
    m-> flags. utf8_accel = SvUTF8( text) ? 1 : 0;
    if ( m-> id > 0)
       if ( var-> stage <= csNormal && var-> system)
@@ -814,7 +814,7 @@ AbstractMenu_key( Handle self, Bool set, char * varName, SV * key)
    if ( !set)
       return newSViv( m-> key);
 
-   m-> key = key_normalize( SvPV( key, na));
+   m-> key = key_normalize( SvPV_nolen( key));
    if ( m-> id > 0)
       if ( var-> stage <= csNormal && var-> system)
          apc_menu_item_set_key( self, m);

diff --git a/Component.c b/Component.c
@@ -244,7 +244,7 @@ Component_name( Handle self, Bool set, SV * name)
 {
    if ( set) {
       free( var-> name);
-      var-> name = duplicate_string( SvPV( name, na));
+      var-> name = duplicate_string( SvPV_nolen( name));
       opt_assign( optUTF8_name, SvUTF8(name));
       if ( var-> stage >= csNormal)
          apc_component_fullname_changed_notify( self);
@@ -667,7 +667,7 @@ XS( Component_notify_FROMPERL)
       croak ("Invalid usage of Component.notify");
    SP -= items;
    self    = gimme_the_mate( ST( 0));
-   name    = ( char*) SvPV( ST( 1), na);
+   name    = ( char*) SvPV_nolen( ST( 1));
    if ( self == nilHandle)
       croak( "Illegal object reference passed to Component.notify");
 
@@ -690,7 +690,7 @@ XS( Component_notify_FROMPERL)
          (void)POPs;
          PUB_CHECK;
          CLOSE_G_EVAL;
-         croak( SvPV( GvSV( errgv), na));
+         croak( SvPV_nolen( GvSV( errgv)));
       } 
       CLOSE_G_EVAL;
       SPAGAIN;
@@ -810,7 +810,7 @@ XS( Component_notify_FROMPERL)
          if ( privMethod) sv_free( privMethod);
          free( argsv);
          free( sequence);
-         croak( SvPV( GvSV( errgv), na));
+         croak( SvPV_nolen( GvSV( errgv)));
       } 
       CLOSE_G_EVAL;
       SPAGAIN;
@@ -1023,7 +1023,7 @@ XS( Component_get_notification_FROMPERL)
       croak( "Illegal object reference passed to Component.get_notification");
 
    if ( var-> eventIDs == nil) XSRETURN_EMPTY;
-   event = ( char *) SvPV( ST( 1), na);
+   event = ( char *) SvPV_nolen( ST( 1));
    ret = hash_fetch( var-> eventIDs, event, strlen( event));
    if ( ret == nil) XSRETURN_EMPTY;
    list = var-> events + PTR2UV( ret) - 1;
@@ -1119,7 +1119,7 @@ Component_delegations( Handle self, Bool set, SV * delegations)
             CV * sub;
             SV * subref;
             char buf[ 1024];
-            char * event = SvPV( *holder, na);
+            char * event = SvPV_nolen( *holder);
             snprintf( buf, 1023, "%s_%s", name, event);
             sub = query_method( referer, buf, 0);
             if ( sub == nil) continue;
@@ -1131,7 +1131,8 @@ Component_delegations( Handle self, Bool set, SV * delegations)
       HE * he;
       AV * av = newAV();
       Handle last = nilHandle;
-      if ( var-> stage > csNormal || var-> eventIDs == nil) newRV_noinc(( SV*) av);
+      if ( var-> stage > csNormal || var-> eventIDs == nil)
+         return newRV_noinc(( SV*) av);
 
       hv_iterinit( var-> eventIDs);
       while (( he = hv_iternext( var-> eventIDs)) != nil) {

diff --git a/Image.c b/Image.c
@@ -500,10 +500,10 @@ XS( Image_load_FROMPERL)
       croak("Invalid usage of Prima::Image::load");
 
    self = gimme_the_mate( ST( 0));
-   fn   = ( char *) SvPV( ST( 1), na);
+   fn   = ( char *) SvPV_nolen( ST( 1));
    profile = parse_hv( ax, sp, items, mark, 2, "Image::load");
    if ( !pexist( className)) 
-      pset_c( className, self ? my-> className : ( char*) SvPV( ST( 0), na));
+      pset_c( className, self ? my-> className : ( char*) SvPV_nolen( ST( 0)));
    ret = apc_img_load( self, fn, profile, error);
    sv_free(( SV *) profile);
    SPAGAIN;
@@ -551,7 +551,7 @@ Image_load( SV * who, char *filename, HV * profile)
    Handle self = gimme_the_mate( who);
    char error[ 256];
    if ( !pexist( className)) 
-      pset_c( className, self ? my-> className : ( char*) SvPV( who, na));
+      pset_c( className, self ? my-> className : ( char*) SvPV_nolen( who));
    ret = apc_img_load( self, filename, profile, error);
    return ret;
 }
@@ -570,7 +570,7 @@ XS( Image_save_FROMPERL)
       croak("Invalid usage of Prima::Image::save");
 
    self = gimme_the_mate( ST( 0));
-   fn   = ( char *) SvPV( ST( 1), na);
+   fn   = ( char *) SvPV_nolen( ST( 1));
    profile = parse_hv( ax, sp, items, mark, 2, "Image::save");
    ret = apc_img_save( self, fn, profile, error);
    sv_free(( SV *) profile);
@@ -600,7 +600,7 @@ Image_save( SV * who, char *filename, HV * profile)
    Handle self = gimme_the_mate( who);
    char error[ 256];
    if ( !pexist( className)) 
-      pset_c( className, self ? my-> className : ( char*) SvPV( who, na));
+      pset_c( className, self ? my-> className : ( char*) SvPV_nolen( who));
    return apc_img_save( self, filename, profile, error);
 }
 

diff --git a/Object.c b/Object.c
@@ -93,7 +93,7 @@ Object_create( char *className, HV * profile)
          OPEN_G_EVAL;
          Object_destroy( self);
          CLOSE_G_EVAL;
-         croak( SvPV( GvSV( errgv), na));
+         croak( SvPV_nolen( GvSV( errgv)));
       }
       CLOSE_G_EVAL;
       SPAGAIN;

diff --git a/Prima/Gencls.pm b/Prima/Gencls.pm
@@ -229,8 +229,8 @@ sub init_variables
 		# 0         1            2           3        4           5        6        7       8
 		'int'     => ['int',    'SvIV',      'sv_setiv',  '',      '(IV)',     '',    'POPi',    'SViv', ''     ],
 		'double'  => ['double', 'SvNV',      'sv_setnv',  '',      '(double)', '',    'POPn',    'SVnv', ''     ],
-		'char*'   => ['char *', 'SvPV',      'sv_setpv',  '(SV*)', '',         ', 0', 'POPp',    'SVpv', ', na' ],
-		'string'  => ['char',   'SvPV',      'sv_setpv',  '(SV*)', '',         ', 0', 'POPp',    'SVpv', ', na' ],
+		'char*'   => ['char *', 'SvPV_nolen','sv_setpv',  '(SV*)', '',         ', 0', 'POPp',    'SVpv', '' ],
+		'string'  => ['char',   'SvPV_nolen','sv_setpv',  '(SV*)', '',         ', 0', 'POPp',    'SVpv', '' ],
 		'Handle'  => ['Handle', $incGetMate, '',          '',      '',         '',    '0/0',     '',     ''     ],
 		'SV*'     => ['SV *',   '',          '',          '',      '',         '',    '0/0',     '',     ''     ],
 		'Bool'    => ['Bool',   'SvBOOL',    'sv_setiv',  '0/0',   '0/0',      '',    'SvBOOL( POPs)', 'SViv', ''     ],
@@ -1499,7 +1499,7 @@ sub out_method_profile
 			if ( $resSub eq "char*") {
 print HEADER <<LABEL;
 	{
-		char * $incRet =$castedResult SvPV( $incRes, na);
+		char * $incRet =$castedResult SvPV_nolen( $incRes);
 		sv_2mortal( $incRes);
 		return $incRet;
 	}
@@ -1701,7 +1701,7 @@ LABEL
 					my $lType  = ${ $structs{ $lVar}[ 0]}[ $j];
 					my $lName  = ${ $structs{ $lVar}[ 1]}[ $j];
 					if ( $lType eq "string") {
-						$paramAuxSet .= "strncpy( $incRes$structCount. $lName, ( char*) SvPV( ST( $stn), na), 255); $incRes$structCount. $lName\[255\]=0;\n\t\t";
+						$paramAuxSet .= "strncpy( $incRes$structCount. $lName, ( char*) SvPV_nolen( ST( $stn)), 255); $incRes$structCount. $lName\[255\]=0;\n\t\t";
 					} else {
 						$paramAuxSet .= "$incRes$structCount. $lName = ";
 						if ( $lType eq "SV*") {
@@ -1725,7 +1725,7 @@ LABEL
 				if ( $lName eq 'SV*') { 
 					$str = "$incRes$structCount\[$incCount\] = ST( $stn + $incCount)" 
 				} elsif ( $lName eq 'string') {
-					$str = "strncpy( $incRes$structCount\[$incCount\], ( char*) SvPV( ST( $stn + $incCount), na), 255);$incRes$structCount\[$incCount\]\[255\]=0"
+					$str = "strncpy( $incRes$structCount\[$incCount\], ( char*) SvPV_nolen( ST( $stn + $incCount)), 255);$incRes$structCount\[$incCount\]\[255\]=0"
 				} else {
 					$str = "$incRes$structCount\[$incCount\] = ( $lType) $xsConv{$lName}[1]( ST( $stn + $incCount)$xsConv{$lName}[8])";
 				}

diff --git a/Printer.c b/Printer.c
@@ -225,7 +225,7 @@ XS( Printer_options_FROMPERL)
    }
    case 2: {
       char *option, *value;
-      option = ( char*) SvPV( ST(1), na);
+      option = ( char*) SvPV_nolen( ST(1));
       if ( apc_prn_get_option( self, option, &value)) {
          SPAGAIN;
          XPUSHs( sv_2mortal( newSVpv( value, 0)));
@@ -242,8 +242,8 @@ XS( Printer_options_FROMPERL)
       char *option, *value;
 
       for ( i = 1; i < items; i+=2) {
-         option = ( char*) SvPV( ST(i), na);
-         value  = (SvOK( ST(i+1)) ? ( char*) SvPV( ST(i+1), na) : nil);
+         option = ( char*) SvPV_nolen( ST(i));
+         value  = (SvOK( ST(i+1)) ? ( char*) SvPV_nolen( ST(i+1)) : nil);
 	 if ( !value) continue;
          if ( !apc_prn_set_option( self, option, value)) continue;
 	 success++;

diff --git a/Utils.c b/Utils.c
@@ -74,7 +74,7 @@ XS(Utils_getdir_FROMPERL) {
    if ( items >= 2) {
       croak( "invalid usage of Prima::Utils::getdir");
    }
-   dirname = SvPV( ST( 0), na);
+   dirname = SvPV_nolen( ST( 0));
    dirlist = apc_getdir( dirname);
    SPAGAIN;
    SP -= items;

diff --git a/Widget.c b/Widget.c
@@ -2324,7 +2324,7 @@ Widget_helpContext( Handle self, Bool set, SV *helpContext)
    if ( set) {
       if ( var-> stage > csFrozen) return nilSV;
       free( var-> helpContext);
-      var-> helpContext = duplicate_string( SvPV( helpContext, na));
+      var-> helpContext = duplicate_string( SvPV_nolen( helpContext));
       opt_assign( optUTF8_helpContext, SvUTF8(helpContext));
    } else {
       helpContext = newSVpv( var-> helpContext ? var-> helpContext : "", 0);
@@ -2342,7 +2342,7 @@ Widget_hint( Handle self, Bool set, SV *hint)
       if ( var-> stage > csFrozen) return nilSV;
       my-> first_that( self, (void*)hint_notify, (void*)hint);
       free( var-> hint);
-      var-> hint = duplicate_string( SvPV( hint, na));
+      var-> hint = duplicate_string( SvPV_nolen( hint));
       opt_assign( optUTF8_hint, SvUTF8(hint));
       if ( application && (( PApplication) application)-> hintVisible &&
            (( PApplication) application)-> hintUnder == self)
@@ -2937,7 +2937,7 @@ Widget_text( Handle self, Bool set, SV *text)
    if ( set) {
       if ( var-> stage > csFrozen) return nilSV;
       free( var-> text);
-      var-> text = duplicate_string( SvPV( text, na));
+      var-> text = duplicate_string( SvPV_nolen( text));
       opt_assign( optUTF8_text, SvUTF8(text));
    } else {
       text = newSVpv( var-> text ? var-> text : "", 0);

diff --git a/include/apricot.h b/include/apricot.h
@@ -249,6 +249,9 @@ extern "C" {
 #define INT2PTR(type,x) ((type)((UV)x))
 #endif
 
+#ifndef SvPV_nolen
+#define SvPV_nolen(_sv)  SvPV(_sv,na)
+#endif
 
 #define PERL_CALL_SV_DIE_BUG_AWARE 1
 
@@ -554,7 +557,7 @@ XS(prima_autoload_##package##_constant) \
    } \
  \
    if ( items != 1) croak( "invalid call to " #package "::constant"); \
-   name = SvPV( ST( 0), na); \
+   name = SvPV_nolen( ST( 0)); \
    SPAGAIN; \
    SP -= items; \
    r = (type *)hash_fetch( table, name, strlen( name)); \
@@ -1304,7 +1307,7 @@ SvBOOL( SV *sv)
 #define pget_sv( key) ((( temporary_prf_Sv = hv_fetch( profile, # key, strlen( # key), 0)) == nil) ? croak( "Panic: bad profile key (``%s'') requested in ``%s'', line %d\n", # key, __FILE__, __LINE__ ), &sv_undef : *temporary_prf_Sv)
 #define pget_i( key)  ( pget_sv( key), SvIV( *temporary_prf_Sv))
 #define pget_f( key)  ( pget_sv( key), SvNV( *temporary_prf_Sv))
-#define pget_c( key)  ( pget_sv( key), SvPV( *temporary_prf_Sv, na))
+#define pget_c( key)  ( pget_sv( key), SvPV_nolen( *temporary_prf_Sv))
 #define pget_H( key)  gimme_the_mate( pget_sv( key))
 #define pget_B( key)  ( SvTRUE( pget_sv( key)))
 

diff --git a/pod/Prima/internals.pod b/pod/Prima/internals.pod
@@ -358,7 +358,7 @@ technique that keeps previous error message and looks like:
     perl_call_method( ... | G_EVAL);    // G_EVAL is necessary
     if ( SvTRUE( GvSV( errgv)) {
         CLOSE_G_EVAL;                   // close brackets
-        croak( SvPV( GvSV( errgv), na));// propagate exception
+        croak( SvPV_nolen( GvSV( errgv)));// propagate exception
         // no code is executed after croak
     }
     CLOSE_G_EVAL;                       // close brackets

diff --git a/primguts.c b/primguts.c
@@ -260,7 +260,7 @@ clean_perl_call_method( char* methname, I32 flags)
       }
       if ( flags & G_EVAL) return ret;
       CLOSE_G_EVAL;
-      croak( SvPV( GvSV( errgv), na));
+      croak( SvPV_nolen( GvSV( errgv)));
    }
 
    if ( !( flags & G_EVAL)) { CLOSE_G_EVAL; }
@@ -285,7 +285,7 @@ clean_perl_call_pv( char* subname, I32 flags)
       }
       if ( flags & G_EVAL) return ret;
       CLOSE_G_EVAL;
-      croak( SvPV( GvSV( errgv), na));
+      croak( SvPV_nolen( GvSV( errgv)));
    }
 
    if ( !( flags & G_EVAL)) { CLOSE_G_EVAL; }
@@ -389,7 +389,7 @@ XS( create_from_Perl)
       Handle  _c_apricot_res_;
       HV *hv = parse_hv( ax, sp, items, mark, 2 - 1, "Object_create");
       _c_apricot_res_ = Object_create(
-         ( char*) SvPV( ST( 0), na),
+         ( char*) SvPV_nolen( ST( 0)),
          hv
       );
       SPAGAIN;
@@ -590,9 +590,9 @@ XS(Prima_options)
       }
       break;
    case 2:
-      value  = (SvOK( ST(1)) ? ( char*) SvPV( ST(1), na) : nil);
+      value  = (SvOK( ST(1)) ? ( char*) SvPV_nolen( ST(1)) : nil);
    case 1:
-      option = ( char*) SvPV( ST(0), na);
+      option = ( char*) SvPV_nolen( ST(0));
       window_subsystem_set_option( option, value);
       break;
    default:
@@ -659,7 +659,7 @@ XS( Prima_message_FROMPERL)
    (void)items;
    if ( items != 1)
       croak("Invalid usage of Prima::%s", "message");
-   apc_show_message((char*) SvPV( ST(0), na), SvUTF8(ST(0)));
+   apc_show_message((char*) SvPV_nolen( ST(0)), SvUTF8(ST(0)));
    XSRETURN_EMPTY;
 }
 
@@ -669,7 +669,7 @@ XS( Prima_dl_export)
    (void)items;
    if ( items != 1)
       croak("Invalid usage of Prima::%s", "dl_export");
-   apc_dl_export((char*) SvPV( ST(0), na));
+   apc_dl_export((char*) SvPV_nolen( ST(0)));
    XSRETURN_EMPTY;
 }
 
@@ -753,7 +753,7 @@ gimme_the_vmt( const char *className)
       /* ISA found! */
       inheritedName = av_fetch( GvAV(( GV *) *isaGlob), 0, 0);
       if ( inheritedName != nil)
-         originalVmt = gimme_the_vmt( SvPV( *inheritedName, na));
+         originalVmt = gimme_the_vmt( SvPV_nolen( *inheritedName));
       else
          return nil; /* The error message will be printed by the previous incarnation */
    }
@@ -982,7 +982,7 @@ call_perl_indirect( Handle self, char *subName, const char *format, Bool c_decl,
             (void)POPs;
             PUB_CHECK;
             CLOSE_G_EVAL;
-            croak( SvPV( GvSV( errgv), na));    /* propagate */
+            croak( SvPV_nolen( GvSV( errgv)));    /* propagate */
          }
          CLOSE_G_EVAL;
 #else
@@ -1013,7 +1013,7 @@ call_perl_indirect( Handle self, char *subName, const char *format, Bool c_decl,
          {
             PUB_CHECK;
             CLOSE_G_EVAL;
-            croak( SvPV( GvSV( errgv), na));    /* propagate */
+            croak( SvPV_nolen( GvSV( errgv)));    /* propagate */
          }
          CLOSE_G_EVAL;
 #else