diff options
author | Gurusamy Sarathy <gsar@cpan.org> | 2000-05-28 06:39:53 +0000 |
---|---|---|
committer | Gurusamy Sarathy <gsar@cpan.org> | 2000-05-28 06:39:53 +0000 |
commit | c9d5ac959cdfa7a668b3bfbbc2b56923c316ef43 (patch) | |
tree | 3e4852c2cfd7989934271082cbe99ae944741cae /gv.c | |
parent | 9983fa3c886b6f0a857997142e62341929a9b601 (diff) | |
download | perl-c9d5ac959cdfa7a668b3bfbbc2b56923c316ef43.tar.gz |
change#2879 broke rvalue autovivification of magicals such as ${$num}
(reworked variant of patch suggested by Simon Cozens)
p4raw-link: @2879 on //depot/perl: 35cd451c5a1303394968903750cc3b3a1a6bc892
p4raw-id: //depot/perl@6126
Diffstat (limited to 'gv.c')
-rw-r--r-- | gv.c | 107 |
1 files changed, 107 insertions, 0 deletions
@@ -1580,3 +1580,110 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } } } + +/* +=for apidoc is_gv_magical + +Returns C<TRUE> if given the name of a magical GV. + +Currently only useful internally when determining if a GV should be +created even in rvalue contexts. + +C<flags> is not used at present but available for future extension to +allow selecting particular classes of magical variable. + +=cut +*/ +bool +Perl_is_gv_magical(pTHX_ char *name, STRLEN len, U32 flags) +{ + if (!len) + return FALSE; + + switch (*name) { + case 'I': + if (len == 3 && strEQ(name, "ISA")) + goto yes; + break; + case 'O': + if (len == 8 && strEQ(name, "OVERLOAD")) + goto yes; + break; + case 'S': + if (len == 3 && strEQ(name, "SIG")) + goto yes; + break; + case '\027': /* $^W & $^WARNING_BITS */ + if (len == 1 + || (len == 12 && strEQ(name, "\027ARNING_BITS")) + || (len == 17 && strEQ(name, "\027IDE_SYSTEM_CALLS"))) + { + goto yes; + } + break; + + case '&': + case '`': + case '\'': + case ':': + case '?': + case '!': + case '-': + case '#': + case '*': + case '[': + case '^': + case '~': + case '=': + case '%': + case '.': + case '(': + case ')': + case '<': + case '>': + case ',': + case '\\': + case '/': + case '|': + case '+': + case ';': + case ']': + case '\001': /* $^A */ + case '\003': /* $^C */ + case '\004': /* $^D */ + case '\005': /* $^E */ + case '\006': /* $^F */ + case '\010': /* $^H */ + case '\011': /* $^I, NOT \t in EBCDIC */ + case '\014': /* $^L */ + case '\017': /* $^O */ + case '\020': /* $^P */ + case '\023': /* $^S */ + case '\024': /* $^T */ + case '\026': /* $^V */ + if (len == 1) + goto yes; + break; + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + if (len > 1) { + char *end = name + len; + while (--end > name) { + if (!isDIGIT(*end)) + return FALSE; + } + } + yes: + return TRUE; + default: + break; + } + return FALSE; +} |