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.