C- perlembed/perlcall示例无界的内存生长 - 瓦格林(Valgrind)说没有可能的泄漏

Question

全部。我一直在猛击这个问题...我试图将基本上是perlembed perlcall的示例汇总在一起，并或多或少地从evpsgi中"借"了它。问题在于它每1000次迭代就会大约生长1MB。这不是在长期生活过程中运行时最大的情况（这是我正在使用的用例）。

作为标题所述，如果我与Valgrind一起运行，则报告说没有可能的泄漏。我跑了 - trace-malloc =是的，看来Free只有在大量呼叫中才在末尾拨打。我知道这可能是Perl的Mo，但是如果至少重新使用记忆并且直到OS杀死该过程才生长，那就太好了。

。

SV_2Mortal的条目提到了有关缓冲区的"被盗"的信息，但我已经用呼叫SV_2Mortal的呼叫使代码没有更改。

不进一步的ADO，这是代码。请原谅它的货物崇拜。预先感谢！

/*
 *
 * cc `perl -MExtUtils::Embed -e ccopts -e ldopts` -Wall -ggdb test_perl_2.c -o test_perl_2
 *
 * # test.psgi
 * use strict;
 * use warnings;
 * my $app = sub  {
 *     return [ 200, [ test => 1 ], [ sprintf( "%d: Hello!!! from %sn", $$, __FILE__ ) ] ];
 * };
 *
 */
#include <stdio.h>
#include <EXTERN.h>               /* from the Perl distribution     */
#include <perl.h>                 /* from the Perl distribution     */
static PerlInterpreter *perlinterp;  /***    The Perl interpreter    ***/
static SV *app;
void do_stuff( void );
SV * get_stuff( void );
SV * call_stuff( SV * );
EXTERN_C void xs_init( pTHX );
EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
EXTERN_C void xs_init( pTHX ) {
    char *file = __FILE__;
    dXSUB_SYS;
    /* DynaLoader is a special case */
    newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
}
int main( int argc, char **argv, char **env ) {
    char code[ 1024 ];
    char psgi[] = "test.psgi";
    char *embedding[] = { "", "-e", "0" };
    PERL_SYS_INIT3( &argc, &argv, &env );
    perlinterp = perl_alloc();
    PERL_SET_CONTEXT( perlinterp );
    perl_construct( perlinterp );
    perl_parse( perlinterp, xs_init, 3, embedding, (char **)NULL );
    PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
    sprintf( code, "do '%s' or die $@", psgi );
    app = eval_pv( code, TRUE ); /* croak_on_error */
    do_stuff();
    PL_perl_destruct_level = 1;
    perl_destruct( perlinterp );
    perl_free( perlinterp );
    PERL_SYS_TERM();
    return 0;
}
void do_stuff( void ) {
    int body_lastindex, i, count;
    AV *response_av, *body_av;
    SV *stuff_sv, *response_sv, *status, *tmp_body_sv, *body_sv;
//  count = 10000;
    count = 10;
    while( count-- ) {
        ENTER;
        SAVETMPS;
        stuff_sv = get_stuff();
        response_sv = call_stuff( stuff_sv );
        if(
            NULL == response_sv ||
            ! SvROK( response_sv ) ||
            SvTYPE( SvRV( response_sv ) ) != SVt_PVAV
        ) {
            printf( "NULL == response_svn" );
            goto CLIENT_END;
        }
        response_av = (AV *)SvRV( response_sv );
        status = *av_fetch( response_av, 0, 0 );
        printf( "status = %ldn", (long)SvIV( status ) );
        body_av = (AV *)SvRV( *av_fetch( response_av, 2, 0 ) );
        body_sv = newSV( 0 );
        body_lastindex = av_len( body_av );
        for( i = 0; i <= body_lastindex; i++ ) {
            tmp_body_sv = (SV *)*av_fetch( body_av, i, 0 );
            if( SvOK( tmp_body_sv ) ) {
                sv_catsv( body_sv, tmp_body_sv );
            }
        }
        printf( "body_sv = %sn", SvPV_nolen( body_sv ) );
CLIENT_END:
        FREETMPS;
        LEAVE;
    }
}
SV * get_stuff( void ) {
    HV *stuff_hv;
//    stuff_hv = (HV *)sv_2mortal((SV *)newHV());
    stuff_hv = newHV();
    if( NULL == hv_store( stuff_hv, "SCRIPT_NAME", strlen( "SCRIPT_NAME" ), newSVpv( "", 0 ), 0 ) ) {
        croak( "hv_store( 'SCRIPT_NAME' )" );
    }
    if( NULL == hv_store( stuff_hv, "REQUEST_METHOD", strlen( "REQUEST_METHOD" ), newSVpv( "GET", 3 ), 0 ) ) {
        croak( "hv_store( 'REQUEST_METHOD' )" );
    }
    if( NULL == hv_store( stuff_hv, "REQUEST_URI", strlen( "REQUEST_URI" ), newSVpv( "/abc?def", 8 ), 0 ) ) {
        croak( "hv_store( 'REQUEST_URI' )" );
    }
    if( NULL == hv_store( stuff_hv, "PATH_INFO", strlen( "PATH_INFO" ), newSVpv( "/abc", 4 ), 0 ) ) {
        croak( "hv_store( 'PATH_INFO' )" );
    }
    if( NULL == hv_store( stuff_hv, "QUERY_STRING", strlen( "QUERY_STRING" ), newSVpv( "def", 3 ), 0 ) ) {
        croak( "hv_store( 'QUERY_STRING' )" );
    }
    return newRV_inc( (SV *)stuff_hv );
}
SV * call_stuff( SV *stuff_sv ) {
    SV *response_sv;
    int count;
//  printf( "REQUEST_URI = %sn", SvPV_nolen( *hv_fetch( (HV *)SvRV( stuff_sv ), "REQUEST_URI", strlen( "REQUEST_URI" ), 0 ) ) );
    dSP;
    ENTER;
    SAVETMPS;
    PUSHMARK( SP );
    XPUSHs( stuff_sv ); // stuff_sv is not mortal.
    PUTBACK;
    count = call_sv( app, G_EVAL | G_SCALAR | G_KEEPERR );
    SPAGAIN;
    if( SvTRUE( ERRSV ) ) {
        response_sv = NULL;
        fprintf( stderr, "FATAL: %s", SvPV_nolen( ERRSV ) );
        /* CLEAR_ERRSV() is only available 5.8.9 or later */
        if( SvMAGICAL( ERRSV ) ) {
            mg_free( ERRSV );
            mg_clear( ERRSV );
        }
        sv_setpvn_mg( ERRSV, "", 0 );
        POPs; // causes "warning: value computed is not used"
    }
    else if( count > 0 ) {
        response_sv = POPs; // is this mortal?
        SvREFCNT_inc( response_sv );
    } else {
        response_sv = NULL;
    }
    PUTBACK;
    FREETMPS;
    LEAVE;
    return response_sv;
}

Answer 1

您什么都没有！您会从Perl获得标量，然后自己创建两个，但它们都没有被释放。

泄漏1

您有：

HV *stuff_hv;
stuff_hv = newHV();
return newRV_inc( (SV *)stuff_hv );

两个问题：

• 您正在创建一个用2的refcnt创建的HV。

  将newRV_inc更改为newRV_noinc。

• 您永远不会释放它（或从XS Func作为凡人返回）。

  完成后使用SvREFCNT_dec( stuff_sv )，也许是在致电call_stuff之后。

泄漏2

您有：

body_sv = newSV( 0 );

再次，该标量没有相应的释放。您需要

SvREFCNT_dec( body_sv );

printf。

泄漏3

您有：

response_sv = POPs; // is this mortal?
SvREFCNT_inc( response_sv );

是否真的重要。您需要要求它的所有权，以防万一，因此inc是适当的。但是，您必须以后完成它。

 SvREFCNT_dec( response_sv );