diff options
author | Father Chrysostomos <sprout@cpan.org> | 2011-08-19 08:27:14 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2011-08-24 23:46:36 -0700 |
commit | 527d644b124fe2e8dfe6e07204f8b22f7a7ab83d (patch) | |
tree | d8f18a6e9b694d9b49fdcf95bd3bbf29810822f7 /gv.c | |
parent | c2f605db621edfb16309200bbba8ced984d34476 (diff) | |
download | perl-527d644b124fe2e8dfe6e07204f8b22f7a7ab83d.tar.gz |
Enable ampersand calls to CORE subs with $$$ prototypes
This applies to functions that just take plain scalar arguments, all
of which are mandatory. Functions that take optional arguments are
not supported yet. truncate() is not supported yet, either (its $$
prototype is not entirely veracious).
This commit enables those functions to be called via &CORE::foo() syn-
tax or through references.
You can now encrypt a string like this: "string"->CORE::crypt($salt).
Each function’s op tree is like this:
$ ./perl -Ilib -MO=Concise,CORE::atan2 -e 'BEGIN{\&CORE::atan2}'
CORE::atan2:
3 <1> leavesub[1 ref] K/REFC,1 ->(end)
2 <@> atan2[t1] sK ->3
- <0> ex-pushmark s ->1
1 <$> coreargs(IV 100) s ->2
-e syntax OK
This commit adds code to ck_fun to skip the argument check if
coresubs is present. Otherwise we get a ‘Not enough arguments for
atan2’ error.
Diffstat (limited to 'gv.c')
-rw-r--r-- | gv.c | 35 |
1 files changed, 24 insertions, 11 deletions
@@ -1352,22 +1352,34 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, case KEY_or: case KEY_x: case KEY_xor: return gv; case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__: - case KEY_abs: case KEY_alarm: case KEY_chr: case KEY_chroot: + case KEY_abs: case KEY_alarm: case KEY_atan2: case KEY_chr: + case KEY_chroot: case KEY_crypt: case KEY_break: case KEY_continue: case KEY_cos: case KEY_endgrent: case KEY_endhostent: case KEY_endnetent: case KEY_endprotoent: case KEY_endpwent: - case KEY_endservent: case KEY_exp: - case KEY_getgrent: case KEY_gethostent: - case KEY_fork: - case KEY_getlogin: case KEY_getnetent: case KEY_getppid: - case KEY_getprotoent: case KEY_getservent: case KEY_getpwent: + case KEY_endservent: case KEY_exp: case KEY_fork: + case KEY_getgrent: case KEY_getgrgid: case KEY_getgrnam: + case KEY_gethostbyaddr: case KEY_gethostbyname: + case KEY_gethostent: case KEY_getlogin: case KEY_getnetbyaddr: + case KEY_getnetbyname: case KEY_getnetent: case KEY_getppid: + case KEY_getpriority: case KEY_getprotobyname: + case KEY_getprotobynumber: case KEY_getprotoent: + case KEY_getpwnam: case KEY_getpwuid: case KEY_getservbyname: + case KEY_getservbyport: case KEY_getservent: case KEY_getpwent: case KEY_hex: case KEY_int: case KEY_lc: case KEY_lcfirst: - case KEY_length: case KEY_log: case KEY_oct: case KEY_ord: + case KEY_length: case KEY_link: case KEY_log: case KEY_msgctl: + case KEY_msgget: case KEY_msgrcv: case KEY_msgsnd: + case KEY_not: case KEY_oct: case KEY_ord: case KEY_quotemeta: case KEY_readlink: case KEY_readpipe: - case KEY_ref: case KEY_rmdir: case KEY_setgrent: - case KEY_setpwent: case KEY_sin: case KEY_sqrt: case KEY_time: - case KEY_times: case KEY_uc: case KEY_ucfirst: - case KEY_wait: case KEY_wantarray: + case KEY_ref: case KEY_rename: case KEY_rmdir: case KEY_semctl: + case KEY_semget: case KEY_semop: case KEY_setgrent: + case KEY_sethostent: case KEY_setnetent: case KEY_setpriority: + case KEY_setprotoent: case KEY_setpwent: case KEY_setservent: + case KEY_shmctl: case KEY_shmget: case KEY_shmread: + case KEY_shmwrite: case KEY_sin: case KEY_sqrt: + case KEY_symlink: case KEY_time: case KEY_times: + case KEY_uc: case KEY_ucfirst: case KEY_vec: + case KEY_wait: case KEY_waitpid: case KEY_wantarray: ampable = TRUE; } if (ampable) { @@ -1401,6 +1413,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, new ATTRSUB. */ (void)core_prototype((SV *)cv, name, code, &opnum); if (ampable) { + if (opnum == OP_VEC) CvLVALUE_on(cv); newATTRSUB(oldsavestack_ix, newSVOP( OP_CONST, 0, |