Changeset 2172

Show
Ignore:
Timestamp:
09/22/08 00:19:34 (4 months ago)
Author:
karpet
Message:

still have some mem leaks somewhere, but this is at least a better approach

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • libswish3/trunk/bindings/perl/3.xs

    r2164 r2172  
    1616PROTOTYPES: enable 
    1717 
    18 INCLUDE: XS/Constants.xs 
     18 
     19void 
     20init(CLASS) 
     21    char* CLASS; 
     22     
     23    CODE: 
     24        swish_init(); 
     25 
     26 
    1927 
    2028swish_3* 
    21 init(CLASS) 
     29_setup(CLASS) 
    2230    char* CLASS; 
    2331 
    …… 
    349357 
    350358 
    351 # utility methods 
    352  
    353359void 
    354360describe(self, obj) 
    …… 
    360366     
    361367     
    362      
     368 
     369void 
     370mem_debug(CLASS) 
     371    char* CLASS; 
     372     
     373    CODE: 
     374        swish_mem_debug(); 
     375         
     376             
     377 
     378int 
     379get_memcount(CLASS) 
     380    char* CLASS; 
     381     
     382    CODE: 
     383        RETVAL = swish_get_memcount(); 
     384         
     385    OUTPUT: 
     386        RETVAL 
     387 
     388 
    363389 
    364390# tokenize() from Perl space uses same C func as tokenizer callback 
    …… 
    372398        swish_TokenIterator* ti; 
    373399        swish_MetaName* metaname; 
    374         xmlChar* meta;   
    375400        xmlChar* context; 
    376401        xmlChar* buf; 
    377          
     402 
    378403    CODE: 
    379404        CLASS           = TOKENITERATOR_CLASS; 
    380405        ti              = swish_init_token_iterator(self); 
    381406        ti->ref_cnt++; 
    382         meta            = (xmlChar*)SWISH_DEFAULT_METANAME;    
    383407        context         = (xmlChar*)SWISH_DEFAULT_METANAME; 
    384408        buf             = (xmlChar*)SvPV(str, PL_na); 
    …… 
    397421        if ( items > 2 ) 
    398422        {             
    399             meta = (xmlChar*)SvPV(ST(2), PL_na); 
     423            metaname = (swish_MetaName*)sp_extract_ptr(ST(2)); 
    400424                             
    401425            if ( items > 3 ) 
    …… 
    405429                 
    406430        } 
    407          
    408         metaname = swish_init_metaname(meta); 
    409         metaname->ref_cnt++; 
    410                          
     431        else { 
     432            metaname = swish_init_metaname((xmlChar*)SWISH_DEFAULT_METANAME); 
     433            metaname->ref_cnt++; 
     434        }    
     435         
    411436        sp_tokenize3( ti, buf, metaname, context ); 
    412          
    413437        RETVAL = ti; 
    414                  
    415                          
     438 
    416439    OUTPUT: 
    417440        RETVAL 
    …… 
    429452        swish_TokenIterator* ti; 
    430453        swish_MetaName* metaname; 
    431         xmlChar* meta;   
    432454        xmlChar* context; 
    433455        xmlChar* buf; 
    434          
     456 
    435457    CODE: 
    436458        CLASS           = TOKENITERATOR_CLASS; 
    437459        ti              = swish_init_token_iterator(self); 
    438460        ti->ref_cnt++; 
    439         meta            = (xmlChar*)SWISH_DEFAULT_METANAME;    
    440461        context         = (xmlChar*)SWISH_DEFAULT_METANAME; 
    441462        buf             = (xmlChar*)SvPV(str, PL_na); 
    442463         
    443464        // TODO reimplement as hashref arg 
    444                  
     465                
     466        // TODO why this check??  
    445467        if (!SvUTF8(str)) 
    446468        { 
    …… 
    453475        if ( items > 2 ) 
    454476        {             
    455             meta = (xmlChar*)SvPV(ST(2), PL_na); 
     477            metaname = (swish_MetaName*)sp_extract_ptr(ST(2)); 
    456478                             
    457479            if ( items > 3 ) 
    …… 
    461483                 
    462484        } 
    463          
    464         metaname = swish_init_metaname(meta); 
    465         metaname->ref_cnt++; 
    466                          
     485        else { 
     486            metaname = swish_init_metaname((xmlChar*)SWISH_DEFAULT_METANAME); 
     487            metaname->ref_cnt++; 
     488        }    
     489         
    467490        swish_tokenize3( ti, buf, metaname, context ); 
    468          
    469491        RETVAL = ti; 
    470                  
    471                          
     492 
    472493    OUTPUT: 
    473494        RETVAL 
    …… 
    476497 
    477498# include the other .xs files 
     499INCLUDE: XS/Constants.xs 
    478500INCLUDE: XS/Config.xs 
    479501INCLUDE: XS/Analyzer.xs 

  • libswish3/trunk/bindings/perl/XS/MetaName.xs

    r2045 r2172  
    22 
    33PROTOTYPES: enable 
     4 
     5swish_MetaName * 
     6new(CLASS, name) 
     7    char * CLASS; 
     8    xmlChar * name; 
     9     
     10    CODE: 
     11        RETVAL = swish_init_metaname(name); 
     12        RETVAL->ref_cnt++; 
     13         
     14    OUTPUT: 
     15        RETVAL 
     16 
     17 
    418 
    519SV* 

  • libswish3/trunk/bindings/perl/XS/Token.xs

    r2168 r2172  
    2424        CLASS  = METANAME_CLASS; 
    2525        RETVAL = self->meta; 
     26        RETVAL->ref_cnt++; 
    2627         
    2728    OUTPUT: 
    …… 
    6364     
    6465    CODE: 
    65         //self->ref_cnt--; 
     66        self->ref_cnt--; 
    6667                         
    6768        if (SWISH_DEBUG) { 
    6869            warn("DESTROYing swish_Token object %s  [%d] [ref_cnt = %d]",  
    6970                SvPV(ST(0), PL_na), self, self->ref_cnt); 
     71            warn("Token has swish_MetaName object ref_cnt = %d",  
     72                self->meta->ref_cnt); 
     73        } 
     74         
     75        if (self->ref_cnt > 0 && self->meta->ref_cnt == 0) { 
     76            SWISH_WARN("Token's MetaName ref_cnt should not be less than Token"); 
    7077        } 
    7178         

  • libswish3/trunk/bindings/perl/XS/TokenIterator.xs

    r2168 r2172  
    2727     
    2828    CODE: 
    29         //self->ref_cnt--; 
     29        self->ref_cnt--; 
    3030                         
    3131        if (SWISH_DEBUG) { 

  • libswish3/trunk/bindings/perl/lib/SWISH/3.pm

    r2168 r2172  
    2626XSLoader::load( __PACKAGE__, $VERSION ); 
    2727 
    28 # our symbol table is populated with newCONSTSUB in 3.xs 
     28# init the memory counter as class method at start up 
     29# and call debug in END block 
     30SWISH::3->init; 
     31 
     32END { 
     33    my $memcount = SWISH::3->get_memcount; 
     34    if ($memcount) { 
     35        warn "suspicious memory count in global cleanup"; 
     36        SWISH::3->mem_debug(); 
     37    } 
     38} 
     39 
     40# our symbol table is populated with newCONSTSUB in Constants.xs 
    2941# directly from libswish3.h, so we just grep the symbol table. 
    3042my @constants = ( grep {m/^SWISH_/} keys %SWISH::3:: ); 
    …… 
    5062    my $class = shift; 
    5163    my %arg   = @_; 
    52     my $self  = $class->init; 
     64    my $self  = $class->_setup; 
    5365 
    5466    if ( $arg{config} ) { 

  • libswish3/trunk/bindings/perl/t/07-refcnt.t

    r2030 r2172  
    1919is( $s3->config->refcount, 1, "config refcount == 1" ); 
    2020 
    21 # avoid spurious mem error from libswish3 
    22 # just because of order of Perl ref cleanup 
    23 undef $analyzer; 
    24  

  • libswish3/trunk/bindings/perl/t/10tokenize.t

    r2168 r2172  
    66ok( my $tokens = $s3->tokenize( 
    77        "now is the time, ain't it? or when else might it be!", 
    8         'foo', 'bar' 
     8        SWISH::3::MetaName->new('foo'), 'bar' 
    99    ), 
    1010    "wordlist" 
    …… 
    3030    } 
    3131 
    32     #diag( '=' x 60 ); 
     32    diag( '=' x 60 ); 
    3333    for my $w (SWISH_TOKEN_FIELDS) { 
    3434 
    …… 
    3737            $val = $val->name; 
    3838        } 
    39         #diag( sprintf( "%15s: %s\n", $w, $val ) ); 
     39 
     40        diag( sprintf( "%15s: %s\n", $w, $val ) ); 
    4041 
    4142    } 
    4243} 
    4344 
    44 #undef $wlist; 
    45 #undef $s3; 

  • libswish3/trunk/bindings/perl/t/11get_set_parser.t

    r2030 r2172  
    1717ok( my $s3 = SWISH::3->new( handler => sub { } ), "new parser" ); 
    1818 
    19 ok( my $conf1 = $s3->get_config, "get initial config" ); 
     19ok( my $conf1 = $s3->get_config,      "get initial config" ); 
    2020ok( my $config = SWISH::3::Config->new, "new config" ); 
    2121ok( !$s3->set_config($config), "set config" ); 
    …… 
    2424); 
    2525ok( my $conf2 = $s3->get_config, "get conf2" ); 
    26 diag("config = $config"); 
    27 diag("conf1 = $conf1"); 
    28 diag("conf2 = $conf2"); 
     26 
     27#diag("config = $config"); 
     28#diag("conf1 = $conf1"); 
     29#diag("conf2 = $conf2"); 
    2930 
    3031ok( my $ana1 = $s3->get_analyzer, "get initial analyzer" ); 
    …… 
    3637ok( my $ana2 = $s3->get_analyzer, "get ana2" ); 
    3738 
    38 # avoid spurious libswish3 mem error due to "random" order of Perl 
    39 # SV cleanup 
    40 #undef $analyzer; 
    41 #undef $ana2; 
    42 #undef $ana1; 
    43 #undef $conf2; 
    44 #undef $conf1; 
    45 #undef $config; 
    46 undef $s3; 
    47  

  • libswish3/trunk/bindings/perl/t/12-stash.t

    r2030 r2172  
    22 
    33{ 
     4 
    45    package MyConfig; 
    56    our @ISA = ('SWISH::3::Config'); 
     7 
    68    sub DESTROY { 
    79        $_[0]->SUPER::DESTROY; 
    …… 
    1012 
    1113use_ok('SWISH::3'); 
    12 ok(my $s3 = SWISH::3->new( config_class => 'MyConfig' ), "new s3"); 
    13 ok(my $conf = $s3->config, "get config"); 
    14 undef $conf; 
    15 undef $s3; 
    16 diag("s3 == undef"); 
     14ok( my $s3 = SWISH::3->new( config_class => 'MyConfig' ), "new s3" ); 
     15ok( my $conf = $s3->config, "get config" ); 

  • libswish3/trunk/bindings/perl/t/13-chained.t

    r2031 r2172  
    44ok(my $a = SWISH::3->new->analyzer,   'new analyzer'); 
    55is($a->refcount, 1,                   'refcount'); 
    6  

  • libswish3/trunk/bindings/perl/t/20metanames.t

    r2151 r2172  
    6868 
    6969} 
    70  
    71 # TODO this ends with -177 mem err