[svn:PHP-Sandwich] r1445 - in PHP-Sandwich/trunk: . lib/PHP t

Author: gschlossnagle
Date: Sun Jul 31 13:46:30 2005
New Revision: 1445

Modified:
   PHP-Sandwich/trunk/lib/PHP/Interpreter.pm
   PHP-Sandwich/trunk/phpfuncs.c
   PHP-Sandwich/trunk/t/test_perl_classes.t
Log:
fix stack corruption errors.



Modified: PHP-Sandwich/trunk/lib/PHP/Interpreter.pm
==============================================================================
--- PHP-Sandwich/trunk/lib/PHP/Interpreter.pm	(original)
+++ PHP-Sandwich/trunk/lib/PHP/Interpreter.pm	Sun Jul 31 13:46:30 2005
@@ -238,8 +238,6 @@ Executes the passed perl code, returning
     ^);
   ?>
 
-B<NOTE> There is currently an issue with instantiating XS based objects via eval().  Use new() instead.
-
 =head3 call()
 
 Call a Perl subroutine, passing optional args and returning the return value into PHP.

Modified: PHP-Sandwich/trunk/phpfuncs.c
==============================================================================
--- PHP-Sandwich/trunk/phpfuncs.c	(original)
+++ PHP-Sandwich/trunk/phpfuncs.c	Sun Jul 31 13:46:30 2005
@@ -111,8 +111,13 @@ PHP_METHOD(perl, getvariable)
 #endif
   var = NULL;
   if(strchr(name, '[') || strchr(name, '{')) {
+    ENTER; SAVETMPS;
     PUSHMARK(SP);
+    EXTEND(SP, 2);
+    PUTBACK;
     var = eval_pv(name, G_VOID);
+    SvREFCNT_inc(var);
+    FREETMPS; LEAVE;
   } else {
     switch (name[0]) {
       case '$':
@@ -217,9 +222,9 @@ static int _sandwich_call_method(char *m
 #ifdef USE_ITHREADS
     aTHX = pl->perl;
 #endif  
-    ENTER;
-    SAVETMPS;
+    ENTER; SAVETMPS;
     PUSHMARK(SP);
+    if(offset < argc) EXTEND(SP, argc - offset);
     for(i = offset; i < argc; i++) {
       var = newSVzval(*args[i], SandwichG(php));
       var = sv_2mortal(var);
@@ -228,20 +233,19 @@ static int _sandwich_call_method(char *m
     PUTBACK;
     cnt = call_pv(method, G_SCALAR | G_EVAL | G_KEEPERR);
     SPAGAIN;
-    if(SvTRUE(ERRSV)) {
-      croak(SvPVx(ERRSV, n_a));
-    } else if(cnt) {
+    if(cnt == 1) {
       prv = POPs;
       SvREFCNT_inc(prv);
-      PUTBACK;
       retval = SvZval(prv TSRMLS_CC);
-      RETURN_ZVAL(retval, 1, 0);
-      SvREFCNT_dec(prv);
+      RETVAL_ZVAL(retval, 1, 0);
     } else {
-      RETURN_NULL();
+      RETVAL_NULL();
     }
-    FREETMPS;
-    LEAVE;
+    if(SvTRUE(ERRSV)) {
+    //  croak(SvPVx(ERRSV, n_a));
+    }
+    PUTBACK;
+    FREETMPS; LEAVE;
     efree(args);
   }
 }
@@ -321,25 +325,18 @@ SV *my_eval_sv(pTHX_ SV *sv, I32 coe) {
   dSP;
   dMARK;
 
-  ENTER;
-  SAVETMPS;
-  PUSHMARK(SP);
-  PUTBACK;
-  cnt = eval_sv(sv, G_SCALAR | G_EVAL | G_KEEPERR);
+  ENTER; SAVETMPS;
+  eval_sv(sv, G_SCALAR|G_EVAL);
  
   SPAGAIN;
-  if(cnt) {
-    retval = POPs;
-    PUTBACK;
-  }
+  retval = POPs;
+  SvREFCNT_inc(retval);
+  PUTBACK;
+  FREETMPS; LEAVE;
+
   if(SvTRUE(ERRSV)) {
     croak(SvPVx(ERRSV, n_a));
-  } else {
-    SvREFCNT_inc(retval);
   }
-
-  FREETMPS;
-  LEAVE;
   return retval;
 }
 
@@ -412,31 +409,30 @@ PHP_METHOD(perl, new)
       WRONG_PARAM_COUNT;
     }
     
-    ENTER;
-    SAVETMPS;
+    ENTER; SAVETMPS;
     PUSHMARK(SP);
+    EXTEND(SP, argc + 1);
     for(i = 0; i < argc; i++) {
       var = newSVzval(*args[i], SandwichG(php));
       var = sv_2mortal(var);
       XPUSHs(var);
     }
     PUTBACK;
-    cnt = call_method("new", G_SCALAR | G_EVAL | G_KEEPERR);
+    cnt = call_method("new", G_SCALAR | G_EVAL);
     SPAGAIN;
-    if(SvTRUE(ERRSV)) {
-      croak(SvPVx(ERRSV, n_a));
-    } else if(cnt) {
+    if(cnt == 1) {
       prv = POPs;
       SvREFCNT_inc(prv);
-      PUTBACK;
       retval = SvZval(prv TSRMLS_CC);
-      RETURN_ZVAL(retval, 1, 0);
-      SvREFCNT_dec(prv);
+      RETVAL_ZVAL(retval, 1, 0);
     } else {
-      RETURN_NULL();
+      RETVAL_NULL();
     }
-    FREETMPS;
-    LEAVE;
+    if(SvTRUE(ERRSV)) {
+    //  croak(SvPVx(ERRSV, n_a));
+    }
+    PUTBACK;
+    FREETMPS; LEAVE;
     efree(args);
   }
 }
@@ -571,7 +567,7 @@ static int _sv_call_method(char *method,
   {
     STRLEN n_a;
     dSP;
- 
+    I32 oldscope = PL_scopestack_ix;
     argc = ZEND_NUM_ARGS();
     args = (zval ***) safe_emalloc(sizeof(zval **), argc, 0);
     if(zend_get_parameters_array_ex(argc, args) == FAILURE) {
@@ -583,9 +579,9 @@ static int _sv_call_method(char *method,
 #ifdef USE_ITHREADS
     aTHX = pl->perl;
 #endif  
-    ENTER;
-    SAVETMPS;
+    ENTER; SAVETMPS;
     PUSHMARK(SP);
+    EXTEND(SP, argc);
     SvREFCNT_inc(pl->sv);
     XPUSHs(pl->sv);
     for(i = offset; i < argc; i++) {
@@ -594,12 +590,10 @@ static int _sv_call_method(char *method,
       XPUSHs(var);
     }
     PUTBACK;
-    cnt = call_method(method, G_SCALAR | G_EVAL | G_KEEPERR);
+    cnt = call_method(method, G_SCALAR | G_EVAL);
     SvREFCNT_dec(pl->sv);
     SPAGAIN;
-    if(SvTRUE(ERRSV)) {
-      croak(SvPVx(ERRSV, n_a));
-    } else if(cnt) {
+    if(cnt == 1) {
         prv = POPs;
       /*
       if(coe && SvTRUE(ERRSV)) {
@@ -607,17 +601,16 @@ static int _sv_call_method(char *method,
       }
       */
       SvREFCNT_inc(prv);
-      PUTBACK;
       retval = SvZval(prv TSRMLS_CC);
-      RETURN_ZVAL(retval, 1, 0);
-      SvREFCNT_dec(prv);
+      RETVAL_ZVAL(retval, 1, 0);
     } else {
-      RETURN_NULL();
+      RETVAL_NULL();
     }
-    /* WTF */
     PUTBACK;
-    FREETMPS;
-    LEAVE;
+    FREETMPS; LEAVE;
+    if(SvTRUE(ERRSV)) {
+    //  croak(SvPVx(ERRSV, n_a));
+    }
     efree(args);
   }
 }

Modified: PHP-Sandwich/trunk/t/test_perl_classes.t
==============================================================================
--- PHP-Sandwich/trunk/t/test_perl_classes.t	(original)
+++ PHP-Sandwich/trunk/t/test_perl_classes.t	Sun Jul 31 13:46:30 2005
@@ -1,6 +1,6 @@
 #!/opt/ecelerity/3rdParty/bin/perl -w
 use strict;
-use Test::More tests => 8;
+use Test::More tests => 10;
 use Test::Builder;
 use IO::File;
 
@@ -32,7 +32,7 @@ ok my $ret = $php->eval(q^
 like $ret, qr/^#\!.*perl\s+-w$/, "We should have a shebang line";
 
 # Make sure that call() works on class methods, too.
-ok my $ret = $php->eval(q^
+ok $ret = $php->eval(q^
     $perl = Perl::getInstance();
     $file = $perl->call('file');
     $fh = $perl->call("IO::File::new", "IO::File", "<$file");
@@ -44,8 +44,16 @@ ok my $ret = $php->eval(q^
 ^), "We should get a value back from the file";
 like $ret, qr/^#\!.*perl\s+-w$/, "We should have a shebang line";
 
-# XXX Without this exit, an extra, unlabled test runs and we get an error:
-# 'Can't call method "eval" on an undefined value at t/test_perl_classes.t
-# line 22, <GEN1> line 1.' Huh? Is there any way to fix that?
 
-exit;
+# Make sure that eval() works on class methods, too.
+ok $ret = $php->eval(q^
+    $perl = Perl::getInstance();
+    $file = $perl->call('file');
+    $fh = $perl->eval("return IO::File->new(\"<$file\");");
+    if ($fh) {
+	return $fh->getline();
+    } else {
+        throw new Exception("Couldn't open $file");
+    }
+^), "We should get a value back from the file";
+like $ret, qr/^#\!.*perl\s+-w$/, "We should have a shebang line";