[svn:PHP-Sandwich] rev 1432 - in PHP-Sandwich/trunk: . t
[email protected] 31 Jul 2005 03:01:38 -0000
| Newsgroups | perl.php.sandwich.dev |
|---|---|
| Message-ID | <[email protected]> |
Author: gschlossnagle
Date: Sat Jul 30 20:01:38 2005
New Revision: 1432
Modified:
PHP-Sandwich/trunk/PHP.xs
PHP-Sandwich/trunk/phpfuncs.c
PHP-Sandwich/trunk/phpinterp.c
PHP-Sandwich/trunk/t/test_perl_classes.t
Log:
all tests pass successful. Note new
new() method for instantiating objects -
doing so for XS routines in eval() seems unsafe.
Modified: PHP-Sandwich/trunk/PHP.xs
==============================================================================
--- PHP-Sandwich/trunk/PHP.xs (original)
+++ PHP-Sandwich/trunk/PHP.xs Sat Jul 30 20:01:38 2005
@@ -95,26 +95,21 @@ 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;
@@ -130,30 +125,24 @@ fprintf(stderr, "%s:%d\n", __FILE__, __L
}
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;
@@ -544,8 +533,6 @@ SV *SAND_eval(interp, code)
CODE:
{
RETVAL = sandwich_eval(interp, code);
- fprintf(stderr, "%s:%d StackDepth: %d\n", __FILE__, __LINE__, SP - MARK);
- sv_dump(RETVAL);
}
OUTPUT:
RETVAL
Modified: PHP-Sandwich/trunk/phpfuncs.c
==============================================================================
--- PHP-Sandwich/trunk/phpfuncs.c (original)
+++ PHP-Sandwich/trunk/phpfuncs.c Sat Jul 30 20:01:38 2005
@@ -231,7 +231,6 @@ static int _sandwich_call_method(char *m
if(SvTRUE(ERRSV)) {
croak(SvPVx(ERRSV, n_a));
} else if(cnt) {
- fprintf(stderr, "%s:%d eval_sv returns %d\n", __FILE__, __LINE__, cnt);
prv = POPs;
SvREFCNT_inc(prv);
PUTBACK;
@@ -322,33 +321,23 @@ SV *my_eval_sv(pTHX_ SV *sv, I32 coe) {
dSP;
dMARK;
- fprintf(stderr, "StackDepth: %d\n", SP - MARK);
ENTER;
SAVETMPS;
PUSHMARK(SP);
PUTBACK;
- fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
- sv_dump(sv);
cnt = eval_sv(sv, G_SCALAR | G_EVAL | G_KEEPERR);
SPAGAIN;
if(cnt) {
- fprintf(stderr, "%s:%d eval_sv returns %d\n", __FILE__, __LINE__, cnt);
retval = POPs;
PUTBACK;
}
- fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
- sv_dump(ERRSV);
if(SvTRUE(ERRSV)) {
- fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
croak(SvPVx(ERRSV, n_a));
} else {
- fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
- sv_dump(SvROK(retval)?SvRV(retval):retval);
SvREFCNT_inc(retval);
}
- fprintf(stderr, "StackDepth: %d\n", SP - MARK);
FREETMPS;
LEAVE;
return retval;
@@ -378,15 +367,10 @@ PHP_METHOD(perl, eval)
aTHX = pl->perl;
#endif
if((rv = sandwich_perl_eval(aTHX_ func)) == NULL) {
-fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
} else {
-fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
- sv_dump(SvROK(rv)?SvRV(rv):rv);
zval *retval = SvZval(rv TSRMLS_CC);
RETURN_ZVAL(retval, 1, 0);
}
-fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
- sv_dump(ERRSV);
}
PHP_METHOD(perl, new)
@@ -442,7 +426,6 @@ PHP_METHOD(perl, new)
if(SvTRUE(ERRSV)) {
croak(SvPVx(ERRSV, n_a));
} else if(cnt) {
- fprintf(stderr, "%s:%d eval_sv returns %d\n", __FILE__, __LINE__, cnt);
prv = POPs;
SvREFCNT_inc(prv);
PUTBACK;
@@ -452,7 +435,6 @@ PHP_METHOD(perl, new)
} else {
RETURN_NULL();
}
- POPs;
FREETMPS;
LEAVE;
efree(args);
@@ -618,7 +600,6 @@ static int _sv_call_method(char *method,
if(SvTRUE(ERRSV)) {
croak(SvPVx(ERRSV, n_a));
} else if(cnt) {
- fprintf(stderr, "%s:%d eval_sv returns %d\n", __FILE__, __LINE__, cnt);
prv = POPs;
/*
if(coe && SvTRUE(ERRSV)) {
@@ -701,8 +682,8 @@ int sv_get_class_name(zval *obj, char **
} else {
tmp = HvNAME((SvSTASH(SvRV(pl->sv))));
if(!tmp) return FAILURE;
- *class_name_len = strlen(tmp) + sizeof("PerlSV::");
- *class_name = emalloc(*class_name_len);
+ *class_name_len = strlen(tmp) + sizeof("PerlSV::") - 1;
+ *class_name = emalloc(*class_name_len + 1);
strncpy(*class_name, "PerlSV::", sizeof("PerlSV::"));
strcat(*class_name, tmp);
}
Modified: PHP-Sandwich/trunk/phpinterp.c
==============================================================================
--- PHP-Sandwich/trunk/phpinterp.c (original)
+++ PHP-Sandwich/trunk/phpinterp.c Sat Jul 30 20:01:38 2005
@@ -206,8 +206,6 @@ int my_eval_string(char *str, zval *retv
}
pv.type = IS_STRING;
- fprintf(stderr, "%s:%d: Evaluating '%s'\n", __FILE__, __LINE__, pv.value.str.val);
-
original_handle_op_arrays = CG(handle_op_arrays);
CG(handle_op_arrays) = 0;
new_op_array = compile_string(&pv, string_name TSRMLS_CC);
@@ -278,8 +276,6 @@ cleanup:
/* FIXME, do i need to copy retval? */
zend_print_zval(&retval, 2);
rv = newSVzval(&retval, interp);
- fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
- sv_dump(rv);
return 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 Sat Jul 30 20:01:38 2005
@@ -1,8 +1,8 @@
#!/opt/ecelerity/3rdParty/bin/perl -w
use strict;
use Test::More tests => 6;
+use Test::Builder;
use IO::File;
-use Data::Dumper;
BEGIN {
use_ok 'PHP::Interpreter' or die;
@@ -10,26 +10,24 @@ BEGIN {
ok my $php = PHP::Interpreter->new, "Create new PHP interpreter";
-# Try using a pure Perl class.
+## Try using a pure Perl class.
ok $php->eval(q/
$perl = Perl::getInstance();
- $test = $perl->eval('$t = Test::Builder->new(); print Dumper $t; $t;');
- var_dump($test);
+ $test = $perl->new('Test::Builder');
return $test->ok(1, "This test should run from PHP!");
/), "The test should have passed and returned a true value";
# Try using an XS module.
sub file { __FILE__ }
-ok my $ret = $php->eval(q/
+ok my $ret = $php->eval(q^
$perl = Perl::getInstance();
$file = $perl->call('file');
- $fh = $perl->eval("IO::File->new(\"<$file\")");
+ $fh = $perl->new("IO::File", "<$file");
if ($fh) {
- return $fh->getline();
+ return $fh->getline();
} else {
- throw new Error("Could not open $file");
+ throw new Exception("Couldn't open $file");
}
-/), "We should get a value back from the file";
-
+^), "We should get a value back from the file";
like $ret, qr/^#\!.*perl\s+-w$/, "We should have a shebang line";
-
+exit;