Change 33857 by [EMAIL PROTECTED] on 2008/05/18 19:29:48
Integrate:
[ 33023]
Remove hardcoded cop.h constants from APItest.pm :-(
Add G_WANT. Make call.t use G_WANT.
[ 33024]
More places that could be using G_WANT, not picked up by change 33021.
[ 33041]
Get C++ compiles going on Solaris again.
[ 33084]
Subject: [PATCH] ext/IPC/SysV/SysV.xs [Re: [Fwd: Smoke [5.11.0] 33016
FAIL(XM)
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Sun, 27 Jan 2008 20:44:46 -0500
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.10/perl/ext/IPC/SysV/SysV.xs#4 integrate
... //depot/maint-5.10/perl/ext/XS/APItest/APItest.pm#3 integrate
... //depot/maint-5.10/perl/ext/XS/APItest/Makefile.PL#2 integrate
... //depot/maint-5.10/perl/ext/XS/APItest/t/call.t#2 integrate
... //depot/maint-5.10/perl/ext/threads/threads.xs#3 integrate
... //depot/maint-5.10/perl/pp_ctl.c#13 integrate
Differences ...
==== //depot/maint-5.10/perl/ext/IPC/SysV/SysV.xs#4 (text) ====
Index: perl/ext/IPC/SysV/SysV.xs
--- perl/ext/IPC/SysV/SysV.xs#3~33719~ 2008-04-21 16:41:15.000000000 -0700
+++ perl/ext/IPC/SysV/SysV.xs 2008-05-18 12:29:48.000000000 -0700
@@ -332,8 +332,16 @@
croak("invalid project id");
}
}
-
- k = ftok(path, proj_id);
+/* Including <sys/types.h> before <sys/ipc.h> makes Tru64
+ * to see the obsolete prototype of ftok() first, grumble. */
+# ifdef __osf__
+# define Ftok_t char*
+/* Configure TODO Ftok_t */
+# endif
+# ifndef Ftok_t
+# define Ftok_t const char*
+# endif
+ k = ftok((Ftok_t)path, proj_id);
ST(0) = k == (key_t) -1 ? &PL_sv_undef : sv_2mortal(newSViv(k));
XSRETURN(1);
#else
@@ -405,7 +413,7 @@
CODE:
#ifdef HAS_SHM
void *caddr = sv2addr(addr);
- int rv = shmdt(caddr);
+ int rv = shmdt((Shmat_t)caddr);
ST(0) = rv == -1 ? &PL_sv_undef : sv_2mortal(newSViv(rv));
XSRETURN(1);
#else
==== //depot/maint-5.10/perl/ext/XS/APItest/APItest.pm#3 (text) ====
Index: perl/ext/XS/APItest/APItest.pm
--- perl/ext/XS/APItest/APItest.pm#2~32700~ 2007-12-22 03:55:16.000000000
-0800
+++ perl/ext/XS/APItest/APItest.pm 2008-05-18 12:29:48.000000000 -0700
@@ -18,24 +18,13 @@
mxpushp mxpushn mxpushi mxpushu
call_sv call_pv call_method eval_sv eval_pv require_pv
G_SCALAR G_ARRAY G_VOID G_DISCARD G_EVAL G_NOARGS
- G_KEEPERR G_NODEBUG G_METHOD
+ G_KEEPERR G_NODEBUG G_METHOD G_WANT
apitest_exception mycroak strtab
my_cxt_getint my_cxt_getsv my_cxt_setint my_cxt_setsv
sv_setsv_cow_hashkey_core sv_setsv_cow_hashkey_notcore
);
-# from cop.h
-sub G_SCALAR() { 0 }
-sub G_ARRAY() { 1 }
-sub G_VOID() { 128 }
-sub G_DISCARD() { 2 }
-sub G_EVAL() { 4 }
-sub G_NOARGS() { 8 }
-sub G_KEEPERR() { 16 }
-sub G_NODEBUG() { 32 }
-sub G_METHOD() { 64 }
-
-our $VERSION = '0.12';
+our $VERSION = '0.13';
use vars '$WARNINGS_ON_BOOTSTRAP';
use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
==== //depot/maint-5.10/perl/ext/XS/APItest/Makefile.PL#2 (text) ====
Index: perl/ext/XS/APItest/Makefile.PL
--- perl/ext/XS/APItest/Makefile.PL#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/XS/APItest/Makefile.PL 2008-05-18 12:29:48.000000000 -0700
@@ -24,8 +24,11 @@
WriteConstants(
PROXYSUBS => 1,
NAME => 'XS::APItest',
- NAMES => [qw(HV_DELETE HV_DISABLE_UVAR_XKEY G_DISCARD HV_FETCH_ISSTORE
- HV_FETCH_ISEXISTS HV_FETCH_LVALUE HV_FETCH_JUST_SV)],
-);
+ NAMES => [qw(HV_DELETE HV_DISABLE_UVAR_XKEY HV_FETCH_ISSTORE
+ HV_FETCH_ISEXISTS HV_FETCH_LVALUE HV_FETCH_JUST_SV
+ G_SCALAR G_ARRAY G_VOID G_DISCARD G_EVAL G_NOARGS
+ G_KEEPERR G_NODEBUG G_METHOD G_FAKINGEVAL),
+ {name=>"G_WANT", default=>["IV", "G_ARRAY|G_VOID"]}],
+ );
sub MY::install { "install ::\n" };
==== //depot/maint-5.10/perl/ext/XS/APItest/t/call.t#2 (text) ====
Index: perl/ext/XS/APItest/t/call.t
--- perl/ext/XS/APItest/t/call.t#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/XS/APItest/t/call.t 2008-05-18 12:29:48.000000000 -0700
@@ -90,31 +90,33 @@
ok(eq_array( [ call_method('meth', $flags, $obj, @$args) ], $expected),
"$description call_method('meth')");
+ my $returnval = ((($flags & G_WANT) == G_ARRAY) || ($flags & G_DISCARD))
+ ? [0] : [ undef, 1 ];
for my $keep (0, G_KEEPERR) {
my $desc = $description . ($keep ? ' G_KEEPERR' : '');
my $exp_err = $keep ? "before\n\t(in cleanup) its_dead_jim\n"
: "its_dead_jim\n";
$@ = "before\n";
ok(eq_array( [ call_sv('d', $flags|G_EVAL|$keep, @$args) ],
- $flags & (G_ARRAY|G_DISCARD) ? [0] : [ undef, 1 ]),
+ $returnval),
"$desc G_EVAL call_sv('d')");
is($@, $exp_err, "$desc G_EVAL call_sv('d') - \$@");
$@ = "before\n";
ok(eq_array( [ call_pv('d', $flags|G_EVAL|$keep, @$args) ],
- $flags & (G_ARRAY|G_DISCARD) ? [0] : [ undef, 1 ]),
+ $returnval),
"$desc G_EVAL call_pv('d')");
is($@, $exp_err, "$desc G_EVAL call_pv('d') - \$@");
$@ = "before\n";
ok(eq_array( [ eval_sv('d()', $flags|$keep) ],
- $flags & (G_ARRAY|G_DISCARD) ? [0] : [ undef, 1 ]),
+ $returnval),
"$desc eval_sv('d()')");
is($@, $exp_err, "$desc eval_sv('d()') - \$@");
$@ = "before\n";
ok(eq_array( [ call_method('d', $flags|G_EVAL|$keep, $obj, @$args) ],
- $flags & (G_ARRAY|G_DISCARD) ? [0] : [ undef, 1 ]),
+ $returnval),
"$desc G_EVAL call_method('d')");
is($@, $exp_err, "$desc G_EVAL call_method('d') - \$@");
}
@@ -138,7 +140,7 @@
[ "its_dead_jim\n" ]), "$description eval { call_pv('d') }");
ok(eq_array( [ eval { eval_sv('d', $flags), $@ }, $@ ],
- [ ($flags & (G_ARRAY|G_DISCARD)) ? (0) : (undef, 1),
+ [ @$returnval,
"its_dead_jim\n", '' ]),
"$description eval { eval_sv('d') }");
==== //depot/maint-5.10/perl/ext/threads/threads.xs#3 (xtext) ====
Index: perl/ext/threads/threads.xs
--- perl/ext/threads/threads.xs#2~33517~ 2008-03-13 13:33:03.000000000
-0700
+++ perl/ext/threads/threads.xs 2008-05-18 12:29:48.000000000 -0700
@@ -452,7 +452,7 @@
SPAGAIN;
for (ii=len-1; ii >= 0; ii--) {
SV *sv = POPs;
- if (jmp_rc == 0 && (! (thread->gimme & G_VOID))) {
+ if (jmp_rc == 0 && (thread->gimme & G_WANT) != G_VOID) {
av_store(params, ii, SvREFCNT_inc(sv));
}
}
@@ -1122,7 +1122,7 @@
MUTEX_LOCK(&thread->mutex);
/* Get the return value from the call_sv */
/* Objects do not survive this process - FIXME */
- if (! (thread->gimme & G_VOID)) {
+ if ((thread->gimme & G_WANT) != G_VOID) {
AV *params_copy;
PerlInterpreter *other_perl;
CLONE_PARAMS clone_params;
@@ -1459,8 +1459,8 @@
CODE:
PERL_UNUSED_VAR(items);
thread = S_SV_to_ithread(aTHX_ ST(0));
- ST(0) = (thread->gimme & G_ARRAY) ? &PL_sv_yes :
- (thread->gimme & G_VOID) ? &PL_sv_undef
+ ST(0) = ((thread->gimme & G_WANT) == G_ARRAY) ? &PL_sv_yes :
+ ((thread->gimme & G_WANT) == G_VOID) ? &PL_sv_undef
/* G_SCALAR */ : &PL_sv_no;
/* XSRETURN(1); - implied */
==== //depot/maint-5.10/perl/pp_ctl.c#13 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#12~33856~ 2008-05-18 09:11:18.000000000 -0700
+++ perl/pp_ctl.c 2008-05-18 12:29:48.000000000 -0700
@@ -2989,9 +2989,9 @@
&& cLISTOPx(cUNOPx(PL_eval_root)->op_first)->op_last->op_type
== OP_REQUIRE)
scalar(PL_eval_root);
- else if (gimme & G_VOID)
+ else if ((gimme & G_WANT) == G_VOID)
scalarvoid(PL_eval_root);
- else if (gimme & G_ARRAY)
+ else if ((gimme & G_WANT) == G_ARRAY)
list(PL_eval_root);
else
scalar(PL_eval_root);
End of Patch.
