From: Ilya Zakharevich Date: Tue, 5 Dec 2000 00:40:25 +0000 (-0500) Subject: Re: [PATCH] The largest hoax of all times? X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=840a7b70755d06740715e982aa756f9d77203c4e;p=p5sagit%2Fp5-mst-13.2.git Re: [PATCH] The largest hoax of all times? Date: Tue, 5 Dec 2000 00:40:25 -0500 Message-ID: <20001205004025.A4050@monk.mps.ohio-state.edu> Subject: Re: [PATCH] The largest hoax of all times? From: Ilya Zakharevich Date: Mon, 4 Dec 2000 23:55:53 -0500 Message-ID: <20001204235553.A1140@monk.mps.ohio-state.edu> Subject: Re: [PATCH] The largest hoax of all times? From: Ilya Zakharevich Date: Tue, 5 Dec 2000 01:28:45 -0500 Message-ID: <20001205012844.A4227@monk.mps.ohio-state.edu> Fix the unpredictable order of DESTROYs. p4raw-id: //depot/perl@7991 --- diff --git a/embed.h b/embed.h index 14dcbd7..6c90a54 100644 --- a/embed.h +++ b/embed.h @@ -702,6 +702,7 @@ #define sv_tainted Perl_sv_tainted #define sv_unmagic Perl_sv_unmagic #define sv_unref Perl_sv_unref +#define sv_unref_flags Perl_sv_unref_flags #define sv_untaint Perl_sv_untaint #define sv_upgrade Perl_sv_upgrade #define sv_usepvn Perl_sv_usepvn @@ -819,6 +820,7 @@ #define sv_utf8_encode Perl_sv_utf8_encode #define sv_utf8_decode Perl_sv_utf8_decode #define sv_force_normal Perl_sv_force_normal +#define sv_force_normal_flags Perl_sv_force_normal_flags #define tmps_grow Perl_tmps_grow #define sv_rvweaken Perl_sv_rvweaken #define magic_killbackrefs Perl_magic_killbackrefs @@ -2165,6 +2167,7 @@ #define sv_tainted(a) Perl_sv_tainted(aTHX_ a) #define sv_unmagic(a,b) Perl_sv_unmagic(aTHX_ a,b) #define sv_unref(a) Perl_sv_unref(aTHX_ a) +#define sv_unref_flags(a,b) Perl_sv_unref_flags(aTHX_ a,b) #define sv_untaint(a) Perl_sv_untaint(aTHX_ a) #define sv_upgrade(a,b) Perl_sv_upgrade(aTHX_ a,b) #define sv_usepvn(a,b,c) Perl_sv_usepvn(aTHX_ a,b,c) @@ -2276,6 +2279,7 @@ #define sv_utf8_encode(a) Perl_sv_utf8_encode(aTHX_ a) #define sv_utf8_decode(a) Perl_sv_utf8_decode(aTHX_ a) #define sv_force_normal(a) Perl_sv_force_normal(aTHX_ a) +#define sv_force_normal_flags(a,b) Perl_sv_force_normal_flags(aTHX_ a,b) #define tmps_grow(a) Perl_tmps_grow(aTHX_ a) #define sv_rvweaken(a) Perl_sv_rvweaken(aTHX_ a) #define magic_killbackrefs(a,b) Perl_magic_killbackrefs(aTHX_ a,b) @@ -4246,6 +4250,8 @@ #define sv_unmagic Perl_sv_unmagic #define Perl_sv_unref CPerlObj::Perl_sv_unref #define sv_unref Perl_sv_unref +#define Perl_sv_unref_flags CPerlObj::Perl_sv_unref_flags +#define sv_unref_flags Perl_sv_unref_flags #define Perl_sv_untaint CPerlObj::Perl_sv_untaint #define sv_untaint Perl_sv_untaint #define Perl_sv_upgrade CPerlObj::Perl_sv_upgrade @@ -4463,6 +4469,8 @@ #define sv_utf8_decode Perl_sv_utf8_decode #define Perl_sv_force_normal CPerlObj::Perl_sv_force_normal #define sv_force_normal Perl_sv_force_normal +#define Perl_sv_force_normal_flags CPerlObj::Perl_sv_force_normal_flags +#define sv_force_normal_flags Perl_sv_force_normal_flags #define Perl_tmps_grow CPerlObj::Perl_tmps_grow #define tmps_grow Perl_tmps_grow #define Perl_sv_rvweaken CPerlObj::Perl_sv_rvweaken diff --git a/embed.pl b/embed.pl index 055c28b..ac43b07 100755 --- a/embed.pl +++ b/embed.pl @@ -2042,6 +2042,7 @@ Ap |void |sv_taint |SV* sv Ap |bool |sv_tainted |SV* sv Apd |int |sv_unmagic |SV* sv|int type Apd |void |sv_unref |SV* sv +Apd |void |sv_unref_flags |SV* sv|U32 flags Ap |void |sv_untaint |SV* sv Apd |bool |sv_upgrade |SV* sv|U32 mt Apd |void |sv_usepvn |SV* sv|char* ptr|STRLEN len @@ -2170,6 +2171,7 @@ ApdM |bool |sv_utf8_downgrade|SV *sv|bool fail_ok ApdM |void |sv_utf8_encode |SV *sv Ap |bool |sv_utf8_decode |SV *sv Ap |void |sv_force_normal|SV *sv +Ap |void |sv_force_normal_flags|SV *sv|U32 flags Ap |void |tmps_grow |I32 n Apd |SV* |sv_rvweaken |SV *sv p |int |magic_killbackrefs|SV *sv|MAGIC *mg diff --git a/objXSUB.h b/objXSUB.h index 91dc6df..5a3850c 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -1781,6 +1781,10 @@ #define Perl_sv_unref pPerl->Perl_sv_unref #undef sv_unref #define sv_unref Perl_sv_unref +#undef Perl_sv_unref_flags +#define Perl_sv_unref_flags pPerl->Perl_sv_unref_flags +#undef sv_unref_flags +#define sv_unref_flags Perl_sv_unref_flags #undef Perl_sv_untaint #define Perl_sv_untaint pPerl->Perl_sv_untaint #undef sv_untaint @@ -2138,6 +2142,10 @@ #define Perl_sv_force_normal pPerl->Perl_sv_force_normal #undef sv_force_normal #define sv_force_normal Perl_sv_force_normal +#undef Perl_sv_force_normal_flags +#define Perl_sv_force_normal_flags pPerl->Perl_sv_force_normal_flags +#undef sv_force_normal_flags +#define sv_force_normal_flags Perl_sv_force_normal_flags #undef Perl_tmps_grow #define Perl_tmps_grow pPerl->Perl_tmps_grow #undef tmps_grow diff --git a/pod/perlapi.pod b/pod/perlapi.pod index e3e7479..f5b237f 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -2368,19 +2368,19 @@ false, defined or undefined. Does not handle 'get' magic. =for hackers Found in file sv.h -=item SvTYPE - -Returns the type of the SV. See C. +=item svtype - svtype SvTYPE(SV* sv) +An enum of flags for Perl types. These are found in the file B +in the C enum. Test these flags with the C macro. =for hackers Found in file sv.h -=item svtype +=item SvTYPE -An enum of flags for Perl types. These are found in the file B -in the C enum. Test these flags with the C macro. +Returns the type of the SV. See C. + + svtype SvTYPE(SV* sv) =for hackers Found in file sv.h @@ -3063,13 +3063,29 @@ Found in file sv.c Unsets the RV status of the SV, and decrements the reference count of whatever was being referenced by the RV. This can almost be thought of -as a reversal of C. See C. +as a reversal of C. This is C with C +of zero. See C. void sv_unref(SV* sv) =for hackers Found in file sv.c +=item sv_unref_flags + +Unsets the RV status of the SV, and decrements the reference count of +whatever was being referenced by the RV. This can almost be thought of +as a reversal of C. The C argument can contain +C to force the reference count to be decremented +(otherwise the decrementing is conditional on the reference count being +different from one or the reference being a readonly SV). +See C. + + void sv_unref_flags(SV* sv, U32 flags) + +=for hackers +Found in file sv.c + =item sv_upgrade Upgrade an SV to a more complex form. Use C. See diff --git a/proto.h b/proto.h index e561d1a..1a3802a 100644 --- a/proto.h +++ b/proto.h @@ -782,6 +782,7 @@ PERL_CALLCONV void Perl_sv_taint(pTHX_ SV* sv); PERL_CALLCONV bool Perl_sv_tainted(pTHX_ SV* sv); PERL_CALLCONV int Perl_sv_unmagic(pTHX_ SV* sv, int type); PERL_CALLCONV void Perl_sv_unref(pTHX_ SV* sv); +PERL_CALLCONV void Perl_sv_unref_flags(pTHX_ SV* sv, U32 flags); PERL_CALLCONV void Perl_sv_untaint(pTHX_ SV* sv); PERL_CALLCONV bool Perl_sv_upgrade(pTHX_ SV* sv, U32 mt); PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len); @@ -919,6 +920,7 @@ PERL_CALLCONV bool Perl_sv_utf8_downgrade(pTHX_ SV *sv, bool fail_ok); PERL_CALLCONV void Perl_sv_utf8_encode(pTHX_ SV *sv); PERL_CALLCONV bool Perl_sv_utf8_decode(pTHX_ SV *sv); PERL_CALLCONV void Perl_sv_force_normal(pTHX_ SV *sv); +PERL_CALLCONV void Perl_sv_force_normal_flags(pTHX_ SV *sv, U32 flags); PERL_CALLCONV void Perl_tmps_grow(pTHX_ I32 n); PERL_CALLCONV SV* Perl_sv_rvweaken(pTHX_ SV *sv); PERL_CALLCONV int Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg); diff --git a/scope.c b/scope.c index 0713fa7..3f41a4e 100644 --- a/scope.c +++ b/scope.c @@ -809,7 +809,7 @@ Perl_leave_scope(pTHX_ I32 base) /* Can clear pad variable in place? */ if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) { if (SvTHINKFIRST(sv)) - sv_force_normal(sv); + sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF); if (SvMAGICAL(sv)) mg_free(sv); diff --git a/sv.c b/sv.c index f875d58..2691430 100644 --- a/sv.c +++ b/sv.c @@ -3068,7 +3068,7 @@ Perl_sv_usepvn_mg(pTHX_ register SV *sv, register char *ptr, register STRLEN len } void -Perl_sv_force_normal(pTHX_ register SV *sv) +Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) { if (SvREADONLY(sv)) { if (SvFAKE(sv)) { @@ -3086,11 +3086,17 @@ Perl_sv_force_normal(pTHX_ register SV *sv) Perl_croak(aTHX_ PL_no_modify); } if (SvROK(sv)) - sv_unref(sv); + sv_unref_flags(sv, flags); else if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) sv_unglob(sv); } +void +Perl_sv_force_normal(pTHX_ register SV *sv) +{ + sv_force_normal_flags(sv, 0); +} + /* =for apidoc sv_chop @@ -5692,17 +5698,21 @@ S_sv_unglob(pTHX_ SV *sv) } /* -=for apidoc sv_unref +=for apidoc sv_unref_flags Unsets the RV status of the SV, and decrements the reference count of whatever was being referenced by the RV. This can almost be thought of -as a reversal of C. See C. +as a reversal of C. The C argument can contain +C to force the reference count to be decremented +(otherwise the decrementing is conditional on the reference count being +different from one or the reference being a readonly SV). +See C. =cut */ void -Perl_sv_unref(pTHX_ SV *sv) +Perl_sv_unref_flags(pTHX_ SV *sv, U32 flags) { SV* rv = SvRV(sv); @@ -5714,12 +5724,29 @@ Perl_sv_unref(pTHX_ SV *sv) } SvRV(sv) = 0; SvROK_off(sv); - if (SvREFCNT(rv) != 1 || SvREADONLY(rv)) + if (SvREFCNT(rv) != 1 || SvREADONLY(rv) || flags) /* SV_IMMEDIATE_UNREF */ SvREFCNT_dec(rv); - else + else /* XXX Hack, but hard to make $a=$a->[1] work otherwise */ sv_2mortal(rv); /* Schedule for freeing later */ } +/* +=for apidoc sv_unref + +Unsets the RV status of the SV, and decrements the reference count of +whatever was being referenced by the RV. This can almost be thought of +as a reversal of C. This is C with the C +being zero. See C. + +=cut +*/ + +void +Perl_sv_unref(pTHX_ SV *sv) +{ + sv_unref_flags(sv, 0); +} + void Perl_sv_taint(pTHX_ SV *sv) { diff --git a/sv.h b/sv.h index b155ece..39c1c29 100644 --- a/sv.h +++ b/sv.h @@ -1096,3 +1096,4 @@ Returns a pointer to the character buffer. #define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv)) #define Sv_Grow sv_grow +#define SV_IMMEDIATE_UNREF 1 diff --git a/t/op/ref.t b/t/op/ref.t index a2baab8..8ae9042 100755 --- a/t/op/ref.t +++ b/t/op/ref.t @@ -1,6 +1,6 @@ #!./perl -print "1..56\n"; +print "1..61\n"; # Test glob operations. @@ -279,14 +279,34 @@ print $$_,"\n"; print ${\$_} for @a; } +# This test is the reason for postponed destruction in sv_unref +$a = [1,2,3]; +$a = $a->[1]; +print "not " unless $a == 2; +print "ok 54\n"; + +sub x::DESTROY {print "ok ", 54 + shift->[0], "\n"} +{ my $a1 = bless [4],"x"; + my $a2 = bless [3],"x"; + { my $a3 = bless [2],"x"; + my $a4 = bless [1],"x"; + 567; + } +} + + # test global destruction +my $test = 59; +my $test1 = $test + 1; +my $test2 = $test + 2; + package FINALE; { - $ref3 = bless ["ok 56\n"]; # package destruction - my $ref2 = bless ["ok 55\n"]; # lexical destruction - local $ref1 = bless ["ok 54\n"]; # dynamic destruction + $ref3 = bless ["ok $test2\n"]; # package destruction + my $ref2 = bless ["ok $test1\n"]; # lexical destruction + local $ref1 = bless ["ok $test\n"]; # dynamic destruction 1; # flush any temp values on stack }