diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2014-09-19 23:12:48 -0700 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2014-09-20 09:25:02 -0700 |
| commit | a623f8939cbcaa58a069807591675c0ebcd4135b (patch) | |
| tree | 6e4f3122df0aefeac3b4eb007f9b869a850c6df9 /sv.h | |
| parent | fd01b4b766a3276a9439cade9b1a047c37876c1b (diff) | |
| download | perl-a623f8939cbcaa58a069807591675c0ebcd4135b.tar.gz | |
Implement the bipolar read-only system
This fixes bugs related to Hash::Util::unlock accidentally unlocking
internal scalars (e.g., that returned by undef()) and allowing them to
be modified.
Internal read-only values are now marked by two flags, the regular
read-only flag, and the new ‘protected’ flag.
Before this SvREADONLY served two purposes:
1) The code would use it to protect things that must not be modi-
fied, ever (except when the core sees fit to do so).
2) Hash::Util and everybody else would use it to make this unmodifia-
ble temporarily when requested by the user.
Internals::SvREADONLY serves the latter purpose and only flips the
read-only flag, so things that need to stay read-only will remain so,
because of the ‘other’ read-only flag, that CPAN doesn’t know about.
(If you are a CPAN author, do not read this.)
Diffstat (limited to 'sv.h')
| -rw-r--r-- | sv.h | 18 |
1 files changed, 12 insertions, 6 deletions
@@ -395,7 +395,8 @@ perform the upgrade if necessary. See C<svtype>. -#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE|SVs_RMG|SVf_IsCOW) +#define SVf_THINKFIRST (SVf_READONLY|SVf_PROTECT|SVf_ROK|SVf_FAKE \ + |SVs_RMG|SVf_IsCOW) #define SVf_OK (SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| \ SVp_IOK|SVp_NOK|SVp_POK|SVpgv_GP) @@ -1070,9 +1071,14 @@ sv_force_normal does nothing. #define SvOBJECT_on(sv) (SvFLAGS(sv) |= SVs_OBJECT) #define SvOBJECT_off(sv) (SvFLAGS(sv) &= ~SVs_OBJECT) -#define SvREADONLY(sv) (SvFLAGS(sv) & SVf_READONLY) -#define SvREADONLY_on(sv) (SvFLAGS(sv) |= SVf_READONLY) -#define SvREADONLY_off(sv) (SvFLAGS(sv) &= ~SVf_READONLY) +#define SvREADONLY(sv) (SvFLAGS(sv) & (SVf_READONLY|SVf_PROTECT)) +#ifdef PERL_CORE +# define SvREADONLY_on(sv) (SvFLAGS(sv) |= (SVf_READONLY|SVf_PROTECT)) +# define SvREADONLY_off(sv) (SvFLAGS(sv) &=~(SVf_READONLY|SVf_PROTECT)) +#else +# define SvREADONLY_on(sv) (SvFLAGS(sv) |= SVf_READONLY) +# define SvREADONLY_off(sv) (SvFLAGS(sv) &= ~SVf_READONLY) +#endif #define SvSCREAM(sv) ((SvFLAGS(sv) & (SVp_SCREAM|SVp_POK)) == (SVp_SCREAM|SVp_POK)) #define SvSCREAM_on(sv) (SvFLAGS(sv) |= SVp_SCREAM) @@ -1900,7 +1906,7 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv>. on-write. */ # define CAN_COW_MASK (SVs_OBJECT|SVs_GMG|SVs_SMG|SVs_RMG|SVf_IOK|SVf_NOK| \ SVf_POK|SVf_ROK|SVp_IOK|SVp_NOK|SVp_POK|SVf_FAKE| \ - SVf_OOK|SVf_BREAK|SVf_READONLY) + SVf_OOK|SVf_BREAK|SVf_READONLY|SVf_PROTECT) #else # define SvRELEASE_IVX(sv) 0 /* This little game brought to you by the need to shut this warning up: @@ -1918,7 +1924,7 @@ mg.c:1024: warning: left-hand operand of comma expression has no effect # define CowREFCNT(sv) (*(U8 *)(SvPVX(sv)+SvLEN(sv)-1)) # define SV_COW_REFCNT_MAX ((1 << sizeof(U8)*8) - 1) # define CAN_COW_MASK (SVf_POK|SVf_ROK|SVp_POK|SVf_FAKE| \ - SVf_OOK|SVf_BREAK|SVf_READONLY) + SVf_OOK|SVf_BREAK|SVf_READONLY|SVf_PROTECT) # endif #endif /* PERL_OLD_COPY_ON_WRITE */ |