@@ -12,7 +12,7 @@ BEGIN {
1212use warnings;
1313use strict;
1414use Config;
15- plan tests => 52 ;
15+ plan tests => 75 ;
1616
1717our $TODO ;
1818
@@ -556,3 +556,161 @@ pass("bug 132799");
556556 " goto LABEL can't be used to go into a construct that is optimized away" );
557557}
558558
559+ note(" Tests of functionality fatalized in Perl 5.44" );
560+ my $msg = q| Use of "goto" to jump into a construct is no longer permitted| ;
561+
562+ {
563+
564+ local $@ ;
565+ my $false = 0;
566+ my $thisok = 0;
567+
568+ eval {
569+ for (my $p =1; $p && goto A; $p =0) {
570+ A: $thisok = 1;
571+ }
572+ };
573+ like($@ , qr /$msg / ,
574+ ' Got expected exception; formerly: following goto and for(;;) loop' );
575+
576+ eval {
577+ no warnings ' void' ;
578+ \sub :lvalue { goto d; ${*{scalar (do { d: \*foo })}} }-> ();
579+ };
580+ like($@ , qr /$msg / ,
581+ ' Got expected exception; formerly: goto into rv2sv, rv2gv and scalar' );
582+
583+ eval {
584+ sub { goto e; $# {; do { e: \@_ } } }-> (1..7);
585+ };
586+ like($@ , qr /$msg / ,
587+ ' Got expected exception; formerly: goto into $#{...}' );
588+
589+ eval {
590+ sub { goto f; prototype \&{; do { f: sub ($) {} } } }-> ();
591+ };
592+ like($@ , qr /$msg / ,
593+ ' Got expected exception; formerly: goto into srefgen, prototype and rv2cv' );
594+
595+ eval {
596+ sub { goto g; ref do { g: [] } }-> ();
597+ };
598+ like($@ , qr /$msg / ,
599+ ' Got expected exception; formerly: goto into ref' );
600+
601+ eval {
602+ sub { goto j; defined undef ${; do { j: \(my $foo = " foo" ) } } }-> ();
603+ };
604+ like($@ , qr /$msg / ,
605+ ' Got expected exception; formerly: goto into defined and undef' );
606+
607+ eval {
608+ sub { goto k; study ++${; do { k: \(my $foo = " foo" ) } } }-> ();
609+ };
610+ like($@ , qr /$msg / ,
611+ ' Got expected exception; formerly: goto into study and preincrement' );
612+
613+ eval {
614+ sub { goto l; ~-!${; do { l: \(my $foo = 0) } }++ }-> ();
615+ };
616+ like($@ , qr /$msg / ,
617+ ' Got expected exception; formerly: goto into complement, not, negation and postincrement' );
618+
619+ eval {
620+ sub { goto n; sin cos exp log sqrt do { n: 1 } }-> ();
621+ };
622+ like($@ , qr /$msg / ,
623+ ' Got expected exception; formerly: goto into sin, cos, exp, log, and sqrt' );
624+
625+ eval {
626+ sub { goto o; srand do { o: 0 } }-> ();
627+ };
628+ like($@ , qr /$msg / ,
629+ ' Got expected exception; formerly: goto into srand' );
630+
631+ eval {
632+ sub { goto p; rand do { p: 1 } }-> ();
633+ };
634+ like($@ , qr /$msg / ,
635+ ' Got expected exception; formerly: goto into rand' );
636+
637+ eval {
638+ sub { goto r; chr ord length int hex oct abs do { r: -15.5 } }-> ();
639+ };
640+ like($@ , qr /$msg / ,
641+ ' Got expected exception; formerly: goto into chr, ord, length, int, hex, oct and abs' );
642+
643+ eval {
644+ sub { goto t; ucfirst lcfirst uc lc do { t: " q" } }-> ();
645+ };
646+ like($@ , qr /$msg / ,
647+ ' Got expected exception; formerly: goto into ucfirst, lcfirst, uc and lc' );
648+
649+ eval {
650+ sub { goto u; \@{; quotemeta do { u: " ." } } }-> ();
651+ };
652+ like($@ , qr /$msg / ,
653+ ' Got expected exception; formerly: goto into rv2av and quotemeta' );
654+
655+ eval {
656+ no warnings ' void' ;
657+ join (" " ,sub { goto v; %{; do { v: +{1..2} } } }-> ());
658+ };
659+ like($@ , qr /$msg / ,
660+ ' Got expected exception; formerly: goto into rv2hv' );
661+
662+ eval {
663+ no warnings ' void' ;
664+ join (" " ,sub { goto w; $_ || do { w: " w" } }-> ());
665+ };
666+ like($@ , qr /$msg / ,
667+ ' Got expected exception; formerly: goto into rhs of or' );
668+
669+ eval {
670+ no warnings ' void' ;
671+ join (" " ,sub { goto x; $_ && do { x: " w" } }-> ());
672+ };
673+ like($@ , qr /$msg / ,
674+ ' Got expected exception; formerly: goto into rhs of and' );
675+
676+ eval {
677+ no warnings ' void' ;
678+ join (" " ,sub { goto z; $_ ? do { z: " w" } : 0 }-> ());
679+ };
680+ like($@ , qr /$msg / ,
681+ ' Got expected exception; formerly: goto into first leg of ?:' );
682+
683+ eval {
684+ no warnings ' void' ;
685+ join (" " ,sub { goto z; $_ ? 0 : do { z: " w" } }-> ());
686+ };
687+ like($@ , qr /$msg / ,
688+ ' Got expected exception; formerly: goto into second leg of ?:' );
689+
690+ eval {
691+ sub { goto z; caller do { z: 0 } }-> ();
692+ };
693+ like($@ , qr /$msg / ,
694+ ' Got expected exception; formerly: goto into caller' );
695+
696+ eval {
697+ sub { goto z; exit do { z: return " foo" } }-> ();
698+ };
699+ like($@ , qr /$msg / ,
700+ ' Got expected exception; formerly: goto into exit' );
701+
702+ eval {
703+ sub { goto z; eval do { z: " 'foo'" } }-> ();
704+ };
705+ like($@ , qr /$msg / ,
706+ ' Got expected exception; formerly: goto into eval' );
707+
708+ eval {
709+ no warnings ' void' ;
710+ join (" ," ,sub { goto z; glob do { z: " foo bar" } }-> ());
711+ };
712+ like($@ , qr /$msg / ,
713+ ' Got expected exception; formerly: goto into glob' );
714+
715+ }
716+
0 commit comments