Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 115 lines (89 sloc) 2.816 kb
fd515aa [t] clean up lvalue_subroutines.t and move to spec/
moritz authored
1 use v6;
2
3 use Test;
4
5 plan 14;
6
7 =begin description
8
9 Testing lvalue-returning subroutines
10
11 =end description
12
eda6db1 [t/spec] move smartlinks from POD to ordinary comments
moritz authored
13 # L<S06/"Lvalue subroutines">
14
fd515aa [t] clean up lvalue_subroutines.t and move to spec/
moritz authored
15 # Lvalue subrefs
16 {
17 my $var1 = 1;
18 my $var2 = 2;
19
20 my $lastvar = sub () is rw { return $var2 };
21 my $prevvar = sub () is rw { return $lastvar() };
22
23 $lastvar() = 3;
24 is $var2, 3, "lvalue subroutine references work (simple)";
25
26 $prevvar() = 4;
27 is $var2, 4, "lvalue subroutine references work (nested)";
28 }
29
30 {
31 my $var = 42;
32 my $notlvalue = sub () { return $var };
33
f25f151 [t/spec] Change more Pugs todo flags to fudge commands
kyle authored
34 #?pugs 2 todo 'bug'
fd515aa [t] clean up lvalue_subroutines.t and move to spec/
moritz authored
35 dies_ok { $notlvalue() = 23 },
f25f151 [t/spec] Change more Pugs todo flags to fudge commands
kyle authored
36 "assigning to non-rw subrefs should die";
fd515aa [t] clean up lvalue_subroutines.t and move to spec/
moritz authored
37 is $var, 42,
f25f151 [t/spec] Change more Pugs todo flags to fudge commands
kyle authored
38 "assigning to non-rw subrefs shouldn't modify the original variable";
fd515aa [t] clean up lvalue_subroutines.t and move to spec/
moritz authored
39 }
40
41 {
42 my $var1 = 1;
43 my $var2 = 2;
44
45 sub lastvar is rw { return $var2; }
46 sub prevvar is rw { return lastvar(); }
47
48 lastvar() = 3;
49 is($var2, 3, "lvalue subroutines work (simple)");
50
51 prevvar() = 4;
52 is($var2, 4, "lvalue subroutines work (nested)");
53 }
54
55 {
56 my $var = 42;
57
58 # S6 says that lvalue subroutines are marked out by 'is rw'
59 sub notlvalue { return $var; } # without rw
60
61 dies_ok { notlvalue() = 5 },
62 "assigning to non-rw subs should die";
63 is $var, 42,
64 "assigning to non-rw subs shouldn't modify the original variable";
65 }
66
67 sub check ($passwd) { return $passwd eq "fish"; };
68
69 sub checklastval ($passwd) is rw {
70 my $proxy is Proxy(
71 FETCH => sub ($self) {
72 return lastval();
73 },
74 STORE => sub ($self, $val) {
75 die "wrong password" unless check($passwd);
76 lastval() = $val;
77 }
78 );
79 return $proxy;
80 };
81
82 my $errors;
83 dies_ok {checklastval("octopus") = 10 }, 'checklastval STORE can die';
84
85 # Above test may well die for the wrong reason, if the Proxy stuff didn't
86 # parse OK, it will complain that it couldn't find the desired subroutine
87 is((try { checklastval("fish") = 12; $val2 }), 12, 'proxy lvalue subroutine STORE works');
88 my $resultval = checklastval("fish");
89 is($resultval, 12, 'proxy lvalue subroutine FETCH works');
90
91 my $realvar = "foo";
92 sub proxyvar ($prefix) is rw {
93 return Proxy.new(
94 FETCH => { $prefix ~ lc($realvar) },
95 STORE => { lc($realvar = $^val) },
96 );
97 }
98 is proxyvar("PRE"), 'PREfoo', 'proxy lvalue subroutine FETCH works';
99 # Return value of assignments of Proxy objects is decided now.
100 # See thread "Assigning Proxy objects" on p6l,
101 # L<"http://www.nntp.perl.org/group/perl.perl6.language/21838">.
102 # Quoting Larry:
103 # The intention is that lvalue subs behave in all respects as if they
104 # were variables.  So consider what
105 #
106 # say $nonproxy = 40;
107 #
108 # should do.
109 is (proxyvar("PRE") = "BAR"), 'BAR',
110 'proxy lvalue subroutine STORE works and returns the correct value';
f25f151 [t/spec] Change more Pugs todo flags to fudge commands
kyle authored
111 #?pugs todo 'feature'
112 is $realvar, 'BAR', 'variable was modified';
fd515aa [t] clean up lvalue_subroutines.t and move to spec/
moritz authored
113
114 # vim: ft=perl6
Something went wrong with that request. Please try again.