[svn:PHP-Sandwich] rev 1428 - in PHP-Sandwich/trunk: . t

Author: gschlossnagle
Date: Fri Jul 29 19:13:45 2005
New Revision: 1428

Modified:
   PHP-Sandwich/trunk/PHP.xs
   PHP-Sandwich/trunk/phpfuncs.c
   PHP-Sandwich/trunk/t/test_perl_classes.t
Log:
partial fixes for test_perl_classes.t, some debugging 
to be removed later


Modified: PHP-Sandwich/trunk/PHP.xs
==============================================================================
--- PHP-Sandwich/trunk/PHP.xs	(original)
+++ PHP-Sandwich/trunk/PHP.xs	Fri Jul 29 19:13:45 2005
@@ -95,7 +95,28 @@ zval *SvZval(SV *sv TSRMLS_DC)
       /* should never happen, we fully dereferenced before */
       break;
     case SVt_PVAV: /* indexed array */
-      {
+fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
+      if(SvMAGICAL(sv)) {
+fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
+        if(strncmp(HvNAME(SvSTASH(sv)), "PHP::Interpreter::Class::", sizeof("PHP::Interpreter::Class::") -1 ) == 0) {
+          MAGIC *mg;
+          PHP_Interpreter_Class pclass;
+fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
+          mg = mg_find(sv, PERL_MAGIC_ext);
+          if(!mg || !mg->mg_obj || !SvROK(mg->mg_obj) || !SvIOK(SvRV(mg->mg_obj))) break;
+          pclass = (PHP_Interpreter_Class) SvIV(SvRV(mg->mg_obj));
+          retval = pclass->val;
+        } else {
+fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
+          // handle non-PHP classes
+          SvREFCNT_inc(orig_sv);
+          plsv_wrap_sv(retval, orig_sv TSRMLS_CC);
+        }
+      }
+      else if(sv_isobject(orig_sv)) {
+fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
+        plsv_wrap_sv(retval, orig_sv TSRMLS_CC);
+      } else {
         int i = 0;
         SV **element;
         I32 cnt = av_len((AV *)sv) + 1;
@@ -109,22 +130,30 @@ zval *SvZval(SV *sv TSRMLS_DC)
       }
       break;
     case SVt_PVHV: /* assoc. array */
+fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
       if(SvMAGICAL(sv)) {
+fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
         if(strncmp(HvNAME(SvSTASH(sv)), "PHP::Interpreter::Class::", sizeof("PHP::Interpreter::Class::") -1 ) == 0) {
           MAGIC *mg;
           PHP_Interpreter_Class pclass;
+fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
           mg = mg_find(sv, PERL_MAGIC_ext);
           if(!mg || !mg->mg_obj || !SvROK(mg->mg_obj) || !SvIOK(SvRV(mg->mg_obj))) break;
           pclass = (PHP_Interpreter_Class) SvIV(SvRV(mg->mg_obj));
           retval = pclass->val;
         } else {
+fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
           // handle non-PHP classes
+          SvREFCNT_inc(orig_sv);
+          plsv_wrap_sv(retval, orig_sv TSRMLS_CC);
         }
       }
       else if(sv_isobject(orig_sv)) {
+fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
         plsv_wrap_sv(retval, orig_sv TSRMLS_CC);
       }
       else {
+fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
         int i = 0;
         SV *element;
         char *key;
@@ -604,7 +633,7 @@ SV* SAND_get_output(interp)
         RETVAL = newSVsv(SvRV(oh));
       }
       else {
-        RETVAL = newSVpv("wtf?", 0);
+        RETVAL = &PL_sv_undef;
       }
     }
   OUTPUT:

Modified: PHP-Sandwich/trunk/phpfuncs.c
==============================================================================
--- PHP-Sandwich/trunk/phpfuncs.c	(original)
+++ PHP-Sandwich/trunk/phpfuncs.c	Fri Jul 29 19:13:45 2005
@@ -357,6 +357,7 @@ PHP_METHOD(perl, eval)
 #endif
   if((rv = sandwich_perl_eval(aTHX_ func)) == NULL)  { 
   } else {
+    sv_dump(SvRV(rv));
     zval *retval = SvZval(rv TSRMLS_CC);
     RETURN_ZVAL(retval, 1, 0);
     SvREFCNT_dec(rv);

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	Fri Jul 29 19:13:45 2005
@@ -2,6 +2,7 @@
 use strict;
 use Test::More tests => 6;
 use IO::File;
+use Data::Dumper;
 
 BEGIN {
     use_ok 'PHP::Interpreter' or die;
@@ -12,7 +13,8 @@ ok my $php = PHP::Interpreter->new, "Cre
 # Try using a pure Perl class.
 ok $php->eval(q/
     $perl = Perl::getInstance();
-    $test = $perl->call('Test::Builder::new', 'Test::Builder');
+    $test = $perl->eval('$t = Test::Builder->new(); print Dumper $t; $t;');
+    var_dump($test);
     return $test->ok(1, "This test should run from PHP!");
 /), "The test should have passed and returned a true value";
 
@@ -22,7 +24,7 @@ sub line { return <+shift> }
 ok my $ret = $php->eval(q/
     $perl = Perl::getInstance();
     $file = $perl->call('file');
-    $fh = $perl->call('IO::File::new', 'IO::File', "<$file");
+    $fh = $perl->eval("IO::File->new(\"<$file\")");
     if ($fh) {
         return $perl->call($fh);
     } else {