summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2012-09-20 11:23:56 -0500
committerJesse Luehrs <doy@tozt.net>2012-09-20 11:23:56 -0500
commitebce020f70f422843e1ea8380fd3ec0d8a63faff (patch)
tree5d41b560744f3fa307bff29a2bf2ee4769148fc5
parent906bcd2d0c4fc4b4c1bbfd6616fbc3c3ba550612 (diff)
downloadfun-ebce020f70f422843e1ea8380fd3ec0d8a63faff.tar.gz
fun-ebce020f70f422843e1ea8380fd3ec0d8a63faff.zip
Revert "make function arguments readonly"
This reverts commit 35d85cfe78dd870384d3aef07a1e852267061097. Looks like we don't actually want this behavior.
-rw-r--r--Fun.xs61
-rw-r--r--t/basic.t5
-rw-r--r--t/readonly.t32
3 files changed, 11 insertions, 87 deletions
diff --git a/Fun.xs b/Fun.xs
index f505239..061e43d 100644
--- a/Fun.xs
+++ b/Fun.xs
@@ -117,23 +117,6 @@ static SV *THX_parse_varname(pTHX_ const char *sigil)
/* end stolen from Scope::Escape::Sugar */
-static XOP readonly_xop;
-
-static OP *pp_readonly(pTHX)
-{
- dSP; dMARK;
- SV** prevmark;
-
- prevmark = MARK;
- MARK++;
- while (MARK <= SP) {
- SvREADONLY_on(*MARK++);
- }
- SP = prevmark;
-
- RETURN;
-}
-
#define parse_parameter_default(i, padoffset) THX_parse_parameter_default(aTHX_ i, padoffset)
static OP *THX_parse_parameter_default(pTHX_ IV i, PADOFFSET padoffset)
{
@@ -170,7 +153,7 @@ static OP *THX_parse_parameter_default(pTHX_ IV i, PADOFFSET padoffset)
#define parse_function_prototype() THX_parse_function_prototype(aTHX)
static OP *THX_parse_function_prototype(pTHX)
{
- OP *myvars, *defaults, *get_args, *arg_assign, *readonly, *ret;
+ OP *myvars, *defaults, *get_args, *arg_assign;
IV i = 0;
demand_unichar('(', DEMAND_IMMEDIATE);
@@ -183,48 +166,35 @@ static OP *THX_parse_function_prototype(pTHX)
myvars = newLISTOP(OP_LIST, 0, NULL, NULL);
defaults = newLISTOP(OP_LINESEQ, 0, NULL, NULL);
- readonly = newLISTOP(OP_CUSTOM, 0, newOP(OP_PUSHMARK, 0), NULL);
- readonly->op_ppaddr = pp_readonly;
for (;;) {
- OP *pad_op, *readonly_pad_op;
+ OP *pad_op;
char next;
I32 type;
SV *name;
- PADOFFSET offset;
lex_read_space(0);
next = lex_peek_unichar(0);
if (next == '$') {
- name = parse_scalar_varname();
- offset = pad_add_my_scalar_sv(name);
pad_op = newOP(OP_PADSV, 0);
- pad_op->op_targ = offset;
- readonly_pad_op = newOP(OP_PADSV, 0);
- readonly_pad_op->op_targ = offset;
+ name = parse_scalar_varname();
+ pad_op->op_targ = pad_add_my_scalar_sv(name);
}
else if (next == '@') {
- name = parse_array_varname();
- offset = pad_add_my_array_sv(name);
pad_op = newOP(OP_PADAV, 0);
- pad_op->op_targ = offset;
- readonly_pad_op = newOP(OP_PADAV, 0);
- readonly_pad_op->op_targ = offset;
+ name = parse_array_varname();
+ pad_op->op_targ = pad_add_my_array_sv(name);
}
else if (next == '%') {
- name = parse_hash_varname();
- offset = pad_add_my_hash_sv(name);
pad_op = newOP(OP_PADHV, 0);
- pad_op->op_targ = offset;
- readonly_pad_op = newOP(OP_PADHV, 0);
- readonly_pad_op->op_targ = offset;
+ name = parse_hash_varname();
+ pad_op->op_targ = pad_add_my_hash_sv(name);
}
else {
croak("syntax error");
}
op_append_elem(OP_LIST, myvars, pad_op);
- op_append_elem(OP_CUSTOM, readonly, readonly_pad_op);
lex_read_space(0);
next = lex_peek_unichar(0);
@@ -262,14 +232,9 @@ static OP *THX_parse_function_prototype(pTHX)
get_args = newUNOP(OP_RV2AV, 0, newGVOP(OP_GV, 0, gv_fetchpv("_", 0, SVt_PVAV)));
arg_assign = newASSIGNOP(OPf_STACKED, myvars, 0, get_args);
- ret = op_prepend_elem(OP_LINESEQ,
- newSTATEOP(0, NULL, arg_assign),
- defaults);
- ret = op_append_elem(OP_LINESEQ,
- ret,
- readonly);
-
- return ret;
+ return op_prepend_elem(OP_LINESEQ,
+ newSTATEOP(0, NULL, arg_assign),
+ defaults);
}
static OP *parse_fun(pTHX_ GV *namegv, SV *psobj, U32 *flagsp)
@@ -353,8 +318,4 @@ BOOT:
{
cv_set_call_parser(get_cv("Fun::fun", 0), parse_fun, &PL_sv_undef);
cv_set_call_checker(get_cv("Fun::fun", 0), check_fun, &PL_sv_undef);
- XopENTRY_set(&readonly_xop, xop_name, "readonly");
- XopENTRY_set(&readonly_xop, xop_desc, "readonly");
- XopENTRY_set(&readonly_xop, xop_class, OA_LISTOP);
- Perl_custom_op_register(aTHX_ pp_readonly, &readonly_xop);
}
diff --git a/t/basic.t b/t/basic.t
index 2b2104f..080c2cf 100644
--- a/t/basic.t
+++ b/t/basic.t
@@ -29,9 +29,4 @@ is(sum(1, 2, 3, 4), 10);
ok(exists $Foo::{foo});
-fun empty ($bar, $baz) { }
-
-is(scalar(empty(1, 2)), undef);
-is_deeply([empty(1, 2)], []);
-
done_testing;
diff --git a/t/readonly.t b/t/readonly.t
deleted file mode 100644
index f0b82ea..0000000
--- a/t/readonly.t
+++ /dev/null
@@ -1,32 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More;
-
-use Fun;
-
-my $thing = 1;
-
-fun foo ($bar) { $bar = 1 }
-
-ok(!eval { foo(); 1 });
-ok(!eval { foo(1); 1 });
-ok(!eval { foo($thing); 1 });
-ok(!eval { foo($thing + 1); 1 });
-
-fun bar ($baz) { $baz }
-
-ok(eval { bar(); 1 });
-ok(eval { bar(1); 1 });
-ok(eval { bar($thing); 1 });
-ok(eval { bar($thing + 1); 1 });
-
-ok(eval { $thing = 2; 1 });
-is($thing, 2);
-
-fun baz ($quux) { $_[0] = 1 }
-
-ok(eval { baz($thing); 1 });
-is($thing, 1);
-
-done_testing;