From fa22d357d948ce8e179d9c7a461076497fc9681e Mon Sep 17 00:00:00 2001 From: Vincent Pit Date: Mon, 27 Jun 2011 10:09:00 +0200 Subject: [PATCH] Test taintedness of values returned by given/when --- t/op/switch.t | 3 ++- t/op/taint.t | 26 +++++++++++++++++++++++++- 2 files changed, 27 insertions(+), 2 deletions(-) diff --git a/t/op/switch.t b/t/op/switch.t index bdf087d..a286559 100644 --- a/t/op/switch.t +++ b/t/op/switch.t @@ -1362,5 +1362,6 @@ unreified_check(undef,""); } # Okay, that'll do for now. The intricacies of the smartmatch -# semantics are tested in t/op/smartmatch.t +# semantics are tested in t/op/smartmatch.t. Taintedness of +# returned values is checked in t/op/taint.t. __END__ diff --git a/t/op/taint.t b/t/op/taint.t index 9df6fee..0c9c2d0 100644 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -17,7 +17,7 @@ BEGIN { use strict; use Config; -plan tests => 774; +plan tests => 780; $| = 1; @@ -2144,6 +2144,30 @@ end is_tainted $dest, "ucfirst(tainted) taints its return value"; } +{ + # Taintedness of values returned from given() + use feature 'switch'; + + my @descriptions = ('when', 'given end', 'default'); + + for (qw) { + my $letter = "$_$TAINT"; + + my $desc = "tainted value returned from " . shift(@descriptions); + + my $res = do { + given ($_) { + when ('x') { $letter } + when ('y') { goto leavegiven } + default { $letter } + leavegiven: $letter + } + }; + is $res, $letter, "$desc is correct"; + is_tainted $res, "$desc stays tainted"; + } +} + # This may bomb out with the alarm signal so keep it last SKIP: { skip "No alarm()" unless $Config{d_alarm}; -- 2.7.4