From 20e5bab43efd0e449d0741f5c5a278e7e20ee9dc Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 20 Jan 2014 12:06:47 +1100 Subject: [PATCH] [perl #121031] fix all of the other incorrect calls to fresh_perl_is() The third argument to fresh_perl_is()/fresh_perl_like() is treated as a hashref, passing a string is kind of strange. --- t/lib/no_load.t | 2 +- t/lib/universal.t | 2 +- t/op/attrs.t | 2 +- t/op/print.t | 2 +- t/op/stash.t | 4 ++-- t/op/sub_lval.t | 2 +- t/re/pat.t | 4 ++-- t/re/pat_advanced.t | 4 ++-- t/re/pat_rt_report.t | 2 +- t/re/subst.t | 6 +++--- t/uni/attrs.t | 2 +- 11 files changed, 16 insertions(+), 16 deletions(-) diff --git a/t/lib/no_load.t b/t/lib/no_load.t index 84a8cac..39f0dc6 100644 --- a/t/lib/no_load.t +++ b/t/lib/no_load.t @@ -26,7 +26,7 @@ foreach my $test ([Carp => qw(warnings Exporter)], use $module; print exists \$INC {'$exclude.pm'} ? "not ok" : "ok"; -- - fresh_perl_is ($prog, "ok", "", "$module does not load $exclude"); + fresh_perl_is ($prog, "ok", {}, "$module does not load $exclude"); } } diff --git a/t/lib/universal.t b/t/lib/universal.t index 71223b4..19f8f28 100644 --- a/t/lib/universal.t +++ b/t/lib/universal.t @@ -10,7 +10,7 @@ BEGIN { } for my $arg ('', 'q[]', qw( 1 undef )) { - fresh_perl_is(<<"----", <<'====', "Internals::* functions check their argument under func() AND &func() [perl #77776]"); + fresh_perl_is(<<"----", <<'====', {}, "Internals::* functions check their argument under func() AND &func() [perl #77776]"); sub tryit { eval shift or warn \$@ } tryit "&Internals::SvREADONLY($arg)"; tryit "&Internals::SvREFCNT($arg)"; diff --git a/t/op/attrs.t b/t/op/attrs.t index d4c8b69..ec6768e 100644 --- a/t/op/attrs.t +++ b/t/op/attrs.t @@ -18,7 +18,7 @@ sub eval_ok ($;$) { is( $@, '', @_); } -fresh_perl_is 'use attributes; print "ok"', 'ok', +fresh_perl_is 'use attributes; print "ok"', 'ok', {}, 'attributes.pm can load without warnings.pm already loaded'; our $anon1; eval_ok '$anon1 = sub : method { $_[0]++ }'; diff --git a/t/op/print.t b/t/op/print.t index 5f2e8b4..a98b0bf 100644 --- a/t/op/print.t +++ b/t/op/print.t @@ -12,7 +12,7 @@ fresh_perl_is('$_ = qq{OK\n}; print STDOUT;', "OK\n", {}, 'print with only a filehandle outputs $_'); SKIP: { skip_if_miniperl('no dynamic loading of PerlIO::scalar in miniperl'); -fresh_perl_is(<<'EOF', "\xC1\xAF\xC1\xAF\xC1\xB0\xC1\xB3", "", "print doesn't launder utf8 overlongs"); +fresh_perl_is(<<'EOF', "\xC1\xAF\xC1\xAF\xC1\xB0\xC1\xB3", {}, "print doesn't launder utf8 overlongs"); use strict; use warnings; diff --git a/t/op/stash.t b/t/op/stash.t index 2681d47..f2e5523 100644 --- a/t/op/stash.t +++ b/t/op/stash.t @@ -61,7 +61,7 @@ package main; fresh_perl_is( 'package A::B; sub a { // }; %A::=""', '', - '', + {}, ); # Variant of the above which creates an object that persists until global # destruction, and triggers an assertion failure prior to change @@ -69,7 +69,7 @@ package main; fresh_perl_is( 'use Exporter; package A; sub a { // }; delete $::{$_} for keys %::', '', - '', + {}, ); } diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t index 21ef319..4bd96ee 100644 --- a/t/op/sub_lval.t +++ b/t/op/sub_lval.t @@ -799,7 +799,7 @@ is $wheel, 8, 'tied pad var explicitly returned in list ref context'; } SKIP: { skip 'no attributes.pm', 1 unless eval 'require attributes'; -fresh_perl_is(<<'----', <<'====', "lvalue can not be set after definition. [perl #68758]"); +fresh_perl_is(<<'----', <<'====', {}, "lvalue can not be set after definition. [perl #68758]"); use warnings; our $x; sub foo { $x } diff --git a/t/re/pat.t b/t/re/pat.t index d539050..d875ea6 100644 --- a/t/re/pat.t +++ b/t/re/pat.t @@ -1246,7 +1246,7 @@ use utf8;; "abc" =~ qr/(?<$char>abc)/; EOP utf8::encode($prog); - fresh_perl_like($prog, qr!Group name must start with a non-digit word character!, "", + fresh_perl_like($prog, qr!Group name must start with a non-digit word character!, {}, sprintf("'U+%04X not legal IDFirst'", ord($char))); } } @@ -1521,7 +1521,7 @@ EOP use re qw(Debug COMPILE); $re; EOP - fresh_perl_like($prog, qr/synthetic stclass/, "stderr", "$re generates a synthetic start class"); + fresh_perl_like($prog, qr/synthetic stclass/, { stderr=>1 }, "$re generates a synthetic start class"); } } diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t index 10a9f69..b45c6f1 100644 --- a/t/re/pat_advanced.t +++ b/t/re/pat_advanced.t @@ -2250,7 +2250,7 @@ EOP { fresh_perl_is('print eval "\"\x{101}\" =~ /[[:lower:]]/", "\n"; print eval "\"\x{100}\" =~ /[[:lower:]]/i", "\n";', "1\n1", # Both re's should match - "", + {}, "get [:lower:] swash in first eval; test under /i in second"); } @@ -2387,7 +2387,7 @@ EOP # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2013-06/msg01290.html fresh_perl_like('use warnings; "abc" =~ qr{(?&foo){0}abc(?)}', 'Quantifier unexpected on zero-length expression', - "", + {}, 'No segfault on qr{(?&foo){0}abc(?)}'); } diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t index 9b53bae..94100d1 100644 --- a/t/re/pat_rt_report.t +++ b/t/re/pat_rt_report.t @@ -1125,7 +1125,7 @@ SKIP: { unless $Config{extensions} =~ / Encode /; # Test case cut down by jhi - fresh_perl_like(<<'EOP', qr!Malformed UTF-8 character \(unexpected end of string\) in substitution \(s///\) at!, 'Segfault using HTML::Entities'); + fresh_perl_like(<<'EOP', qr!Malformed UTF-8 character \(unexpected end of string\) in substitution \(s///\) at!, {}, 'Segfault using HTML::Entities'); use Encode; my $t = ord('A') == 193 ? "\xEA" : "\xE9"; Encode::_utf8_on($t); diff --git a/t/re/subst.t b/t/re/subst.t index d4e9367..244bcad 100644 --- a/t/re/subst.t +++ b/t/re/subst.t @@ -668,11 +668,11 @@ is($name, "cis", q[#22351 bug with 'e' substitution modifier]); } } -fresh_perl_is( '$_=q(foo);s/(.)\G//g;print' => 'foo', +fresh_perl_is( '$_=q(foo);s/(.)\G//g;print' => 'foo', {}, '[perl #69056] positive GPOS regex segfault' ); -fresh_perl_is( '$_="abcdef"; s/bc|(.)\G(.)/$1 ? "[$1-$2]" : "XX"/ge; print' => 'aXXdef', +fresh_perl_is( '$_="abcdef"; s/bc|(.)\G(.)/$1 ? "[$1-$2]" : "XX"/ge; print' => 'aXXdef', {}, 'positive GPOS regex substitution failure (#69056, #114884)' ); -fresh_perl_is( '$_="abcdefg123456"; s/(?<=...\G)?(\d)/($1)/; print' => 'abcdefg(1)23456', +fresh_perl_is( '$_="abcdefg123456"; s/(?<=...\G)?(\d)/($1)/; print' => 'abcdefg(1)23456', {}, 'positive GPOS lookbehind regex substitution failure #114884' ); # s/..\G//g should stop after the first iteration, rather than working its diff --git a/t/uni/attrs.t b/t/uni/attrs.t index 1bf8da9..3ea2f68 100644 --- a/t/uni/attrs.t +++ b/t/uni/attrs.t @@ -21,7 +21,7 @@ sub eval_ok ($;$) { is( $@, '', @_); } -fresh_perl_is 'use attributes; print "ok"', 'ok', +fresh_perl_is 'use attributes; print "ok"', 'ok', {}, 'attributes.pm can load without warnings.pm already loaded'; eval 'sub è1 ($) : plùgh ;'; -- 2.7.4