Changeset 22797 for v6

Show
Ignore:
Timestamp:
10/28/08 13:44:28 (2 months ago)
Author:
ruoso
Message:

[smop-XS] support constant identifiers...

Location:
v6/smop/SMOP
Files:
3 modified

Legend:

Unmodified
Added
Removed

  • v6/smop/SMOP/SMOP.xs

    r22796 r22797  
    88#include <smop_native.h> 
    99#include <smop_s1p.h> 
     10#include <smop_identifiers.h> 
    1011 
    1112MODULE = SMOP           PACKAGE = SMOP           
    … …  
    2829 
    2930SV* 
    30 AUTOLOAD(SV* self, ...) 
     31__dispatch(char* name, SV* self, AV* positional, HV* named) 
    3132  CODE: 
    3233    printf("TODO!\n"); 
    … …  
    7980  OUTPUT: 
    8081    RETVAL 
     82 
     83MODULE = SMOP       PACKAGE = SMOP::NATIVE::idconst 
     84 
     85SV* 
     86create(SV* p5class, char* val) 
     87  CODE: 
     88    SV* pointer = newSViv((int)SMOP__NATIVE__idconst_create(val)); 
     89    SV* object = newRV_noinc(pointer); 
     90    HV* class = gv_stashpv("SMOP::Object", 0); 
     91    RETVAL = sv_bless(object, class); 
     92  OUTPUT: 
     93    RETVAL 
     94 
     95char* 
     96fetch(SV* self) 
     97  CODE: 
     98    SV* value = SvRV(self); 
     99    SMOP__Object* object = (SMOP__Object*)SvIV(value); 
     100    if (SMOP_RI(object) == SMOP_RI(SMOP__ID__new)) { 
     101        int retsize; 
     102        RETVAL = SMOP__NATIVE__idconst_fetch(object, &retsize); 
     103    } else { 
     104        printf("Calling SMOP::NATIVE::int->fetch on a non-native int.\n"); 
     105        RETVAL = 0; 
     106    } 
     107  OUTPUT: 
     108    RETVAL 

  • v6/smop/SMOP/lib/SMOP.pm

    r22796 r22797  
    1010require XSLoader; 
    1111XSLoader::load('SMOP', $VERSION); 
     12 
     13package SMOP::Object; 
     14 
     15our $AUTOLOAD; 
     16 
     17sub AUTOLOAD { 
     18    my $self = shift; 
     19    my $name = $AUTOLOAD; 
     20    $name =~ s/.*://; 
     21    __dispatch($name, $self, [ @_ ], { @_ }); 
     22} 
    1223 
    13241; 

  • v6/smop/SMOP/t/SMOP.t

    r22795 r22797  
    11 
    2 use Test::More tests => 8; 
     2use Test::More tests => 11; 
    33BEGIN { use_ok('SMOP') }; 
    44 
    … …  
    1515ok(!$@,'Can call SMOP::NATIVE::int->create'); 
    1616is(ref($r),'SMOP::Object','returns a SMOP::Object'); 
     17is($r->SMOP::NATIVE::int::fetch, 4, 'fetches the int'); 
    1718 
    18 is($r->SMOP::NATIVE::int::fetch, 4, 'fetches the int'); 
     19eval '$r = SMOP::NATIVE::idconst->create("Hello World!")'; 
     20ok(!$@,'Can call SMOP::NATIVE::idconst->create'); 
     21is(ref($r),'SMOP::Object','returns a SMOP::Object'); 
     22is($r->SMOP::NATIVE::idconst::fetch, 'Hello World!', 'fetches the idconst');