Change 25481 by [EMAIL PROTECTED] on 2005/09/19 08:29:59
Integrate:
[ 24533]
add access to Perl_croak() via 'mycroak' in XS::APItest
[ 24827]
Croak if an attempt is made to modify PL_strtab
(er, TODO - these should be in perldiag)
[ 25070]
Tests for hv_delayfree_ent and hv_free_ent
[ 25072]
Implement hv_delayfree_ent in terms of hv_free_ent
[ 25074]
Perl_share_hek needs exporting for change 25070 on Win32
[ 25075]
Use void, not void *, to suppress RETVAL (and compiler warning)
[ 25078]
Make the tests for hv_free_ent and hv_delayfree_ent pass under
-DPURIFY too.
Affected files ...
... //depot/maint-5.8/perl/embed.fnc#75 integrate
... //depot/maint-5.8/perl/embed.h#67 integrate
... //depot/maint-5.8/perl/ext/XS/APItest/APItest.pm#8 integrate
... //depot/maint-5.8/perl/ext/XS/APItest/APItest.xs#9 integrate
... //depot/maint-5.8/perl/ext/XS/APItest/t/exception.t#1 branch
... //depot/maint-5.8/perl/global.sym#30 integrate
... //depot/maint-5.8/perl/hv.c#52 integrate
Differences ...
==== //depot/maint-5.8/perl/embed.fnc#75 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#74~25473~ Sun Sep 18 09:12:05 2005
+++ perl/embed.fnc Mon Sep 19 01:29:59 2005
@@ -710,7 +710,7 @@
p |I32 |setenv_getix |char* nam
#endif
p |void |setdefout |GV* gv
-p |HEK* |share_hek |const char* sv|I32 len|U32 hash
+Ap |HEK* |share_hek |const char* sv|I32 len|U32 hash
np |Signal_t |sighandler |int sig
Anp |Signal_t |csighandler |int sig
Ap |SV** |stack_grow |NN SV** sp|NN SV**p|int n
==== //depot/maint-5.8/perl/embed.h#67 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#66~25473~ Sun Sep 18 09:12:05 2005
+++ perl/embed.h Mon Sep 19 01:29:59 2005
@@ -762,7 +762,9 @@
#endif
#ifdef PERL_CORE
#define setdefout Perl_setdefout
+#endif
#define share_hek Perl_share_hek
+#ifdef PERL_CORE
#define sighandler Perl_sighandler
#endif
#define csighandler Perl_csighandler
@@ -2751,7 +2753,9 @@
#endif
#ifdef PERL_CORE
#define setdefout(a) Perl_setdefout(aTHX_ a)
+#endif
#define share_hek(a,b,c) Perl_share_hek(aTHX_ a,b,c)
+#ifdef PERL_CORE
#define sighandler Perl_sighandler
#endif
#define csighandler Perl_csighandler
==== //depot/maint-5.8/perl/ext/XS/APItest/APItest.pm#8 (text) ====
Index: perl/ext/XS/APItest/APItest.pm
--- perl/ext/XS/APItest/APItest.pm#7~24400~ Thu May 5 08:48:01 2005
+++ perl/ext/XS/APItest/APItest.pm Mon Sep 19 01:29:59 2005
@@ -19,6 +19,7 @@
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
+ mycroak strtab
);
# from cop.h
@@ -32,7 +33,7 @@
sub G_NODEBUG() { 32 }
sub G_METHOD() { 64 }
-our $VERSION = '0.06';
+our $VERSION = '0.08';
bootstrap XS::APItest $VERSION;
==== //depot/maint-5.8/perl/ext/XS/APItest/APItest.xs#9 (text) ====
Index: perl/ext/XS/APItest/APItest.xs
--- perl/ext/XS/APItest/APItest.xs#8~24179~ Wed Apr 6 09:03:39 2005
+++ perl/ext/XS/APItest/APItest.xs Mon Sep 19 01:29:59 2005
@@ -3,6 +3,61 @@
#include "XSUB.h"
+/* A routine to test hv_delayfree_ent
+ (which itself is tested by testing on hv_free_ent */
+
+typedef void (freeent_function)(pTHX_ HV *, register HE *);
+
+void
+test_freeent(freeent_function *f) {
+ dTHX;
+ dSP;
+ HV *test_hash = newHV();
+ HE *victim;
+ SV *test_scalar;
+ U32 results[4];
+ int i;
+
+#ifdef PURIFY
+ victim = (HE*)safemalloc(sizeof(HE));
+#else
+ /* Storing then deleting something should ensure that a hash entry is
+ available. */
+ hv_store(test_hash, "", 0, &PL_sv_yes, 0);
+ hv_delete(test_hash, "", 0, 0);
+
+ /* We need to "inline" new_he here as it's static, and the functions we
+ test expect to be able to call del_HE on the HE */
+ if (!PL_he_root)
+ croak("PL_he_root is 0");
+ victim = PL_he_root;
+ PL_he_root = HeNEXT(victim);
+#endif
+
+ victim->hent_hek = Perl_share_hek(aTHX_ "", 0, 0);
+
+ test_scalar = newSV(0);
+ SvREFCNT_inc(test_scalar);
+ victim->hent_val = test_scalar;
+
+ /* Need this little game else we free the temps on the return stack. */
+ results[0] = SvREFCNT(test_scalar);
+ SAVETMPS;
+ results[1] = SvREFCNT(test_scalar);
+ f(aTHX_ test_hash, victim);
+ results[2] = SvREFCNT(test_scalar);
+ FREETMPS;
+ results[3] = SvREFCNT(test_scalar);
+
+ i = 0;
+ do {
+ mPUSHu(results[i]);
+ } while (++i < sizeof(results)/sizeof(results[0]));
+
+ /* Goodbye to our extra reference. */
+ SvREFCNT_dec(test_scalar);
+}
+
MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash
#define UTF8KLEN(sv, len) (SvUTF8(sv) ? -(I32)len : (I32)len)
@@ -106,6 +161,19 @@
RETVAL = newSVsv(*result);
OUTPUT:
RETVAL
+
+void
+test_hv_free_ent()
+ PPCODE:
+ test_freeent(&Perl_hv_free_ent);
+ XSRETURN(4);
+
+void
+test_hv_delayfree_ent()
+ PPCODE:
+ test_freeent(&Perl_hv_delayfree_ent);
+ XSRETURN(4);
+
=pod
sub TIEHASH { bless {}, $_[0] }
@@ -328,3 +396,15 @@
+void
+mycroak(pv)
+ const char* pv
+ CODE:
+ Perl_croak(aTHX_ "%s", pv);
+
+SV*
+strtab()
+ CODE:
+ RETVAL = newRV_inc((SV*)PL_strtab);
+ OUTPUT:
+ RETVAL
==== //depot/maint-5.8/perl/ext/XS/APItest/t/exception.t#1 (text) ====
Index: perl/ext/XS/APItest/t/exception.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/ext/XS/APItest/t/exception.t Mon Sep 19 01:29:59 2005
@@ -0,0 +1,36 @@
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
+ print "1..0 # Skip: XS::APItest was not built\n";
+ exit 0;
+ }
+}
+
+use Test::More tests => 9;
+
+BEGIN { use_ok('XS::APItest') };
+
+#########################
+
+my $rv;
+
+$XS::APItest::exception_caught = undef;
+
+$rv = eval { exception(0) };
+is($@, '');
+ok(defined $rv);
+is($rv, 42);
+is($XS::APItest::exception_caught, 0);
+
+$XS::APItest::exception_caught = undef;
+
+$rv = eval { exception(1) };
+is($@, "boo\n");
+ok(not defined $rv);
+is($XS::APItest::exception_caught, 1);
+
+$rv = eval { mycroak("foobar\n") };
+is($@, "foobar\n", 'croak');
==== //depot/maint-5.8/perl/global.sym#30 (text+w) ====
Index: perl/global.sym
--- perl/global.sym#29~25472~ Sun Sep 18 08:52:39 2005
+++ perl/global.sym Mon Sep 19 01:29:59 2005
@@ -423,6 +423,7 @@
Perl_scan_num
Perl_scan_oct
Perl_screaminstr
+Perl_share_hek
Perl_csighandler
Perl_stack_grow
Perl_start_subparse
==== //depot/maint-5.8/perl/hv.c#52 (text) ====
Index: perl/hv.c
--- perl/hv.c#51~25479~ Sun Sep 18 16:40:46 2005
+++ perl/hv.c Mon Sep 19 01:29:59 2005
@@ -1437,18 +1437,12 @@
{
if (!entry)
return;
- if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME_get(hv))
- PL_sub_generation++; /* may be deletion of method from stash */
- sv_2mortal(HeVAL(entry)); /* free between statements */
+ /* SvREFCNT_inc to counter the SvREFCNT_dec in hv_free_ent */
+ sv_2mortal(SvREFCNT_inc(HeVAL(entry))); /* free between statements */
if (HeKLEN(entry) == HEf_SVKEY) {
- sv_2mortal(HeKEY_sv(entry));
- Safefree(HeKEY_hek(entry));
+ sv_2mortal(SvREFCNT_inc(HeKEY_sv(entry)));
}
- else if (HvSHAREKEYS(hv))
- unshare_hek(HeKEY_hek(entry));
- else
- Safefree(HeKEY_hek(entry));
- del_HE(entry);
+ hv_free_ent(hv, entry);
}
/*
End of Patch.
