#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
#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
#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)
#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)
#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
#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
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
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
#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
#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
=for hackers
Found in file sv.h
-=item SvTYPE
-
-Returns the type of the SV. See C<svtype>.
+=item svtype
- svtype SvTYPE(SV* sv)
+An enum of flags for Perl types. These are found in the file B<sv.h>
+in the C<svtype> enum. Test these flags with the C<SvTYPE> 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<sv.h>
-in the C<svtype> enum. Test these flags with the C<SvTYPE> macro.
+Returns the type of the SV. See C<svtype>.
+
+ svtype SvTYPE(SV* sv)
=for hackers
Found in file sv.h
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<newSVrv>. See C<SvROK_off>.
+as a reversal of C<newSVrv>. This is C<sv_unref_flags> with C<flag>
+of zero. See C<SvROK_off>.
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<newSVrv>. The C<cflags> argument can contain
+C<SV_IMMEDIATE_UNREF> 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<SvROK_off>.
+
+ 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<SvUPGRADE>. See
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);
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);
/* 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);
}
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)) {
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
}
/*
-=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<newSVrv>. See C<SvROK_off>.
+as a reversal of C<newSVrv>. The C<cflags> argument can contain
+C<SV_IMMEDIATE_UNREF> 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<SvROK_off>.
=cut
*/
void
-Perl_sv_unref(pTHX_ SV *sv)
+Perl_sv_unref_flags(pTHX_ SV *sv, U32 flags)
{
SV* rv = SvRV(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<newSVrv>. This is C<sv_unref_flags> with the C<flag>
+being zero. See C<SvROK_off>.
+
+=cut
+*/
+
+void
+Perl_sv_unref(pTHX_ SV *sv)
+{
+ sv_unref_flags(sv, 0);
+}
+
void
Perl_sv_taint(pTHX_ SV *sv)
{
#define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv))
#define Sv_Grow sv_grow
+#define SV_IMMEDIATE_UNREF 1
#!./perl
-print "1..56\n";
+print "1..61\n";
# Test glob operations.
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
}
projects / p5sagit/p5-mst-13.2.git / commitdiff