[p5sagit/p5-mst-13.2.git] / t / pragma / warn / pp_ctl

  pp_ctl.c	AOK
 
     Not enough format arguments	
 	format STDOUT =
 	@<<< @<<<
 	$a
 	.
 	write;
     

    Exiting substitution via %s
	$_ = "abc" ;
	while ($i ++ == 0)
	{
    	    s/ab/last/e ;
	}

    Exiting subroutine via %s		
	sub fred { last }
	{ fred() }

    Exiting eval via %s	
	{ eval "last" }

    Exiting pseudo-block via %s 
	@a = (1,2) ; @b = sort { last } @a ;

    Exiting substitution via %s
	$_ = "abc" ;
	last fred:
	while ($i ++ == 0)
	{
    	    s/ab/last fred/e ;
	}


    Exiting subroutine via %s
	sub fred { last joe }
	joe: { fred() }

    Exiting eval via %s
	fred: { eval "last fred" }

    Exiting pseudo-block via %s 
	@a = (1,2) ; fred: @b = sort { last fred } @a ;


    Deep recursion on subroutine \"%s\"
	sub fred
	{
    	goto &fred() if $a++ < 200
	}
	 
	goto &fred()

      (in cleanup) foo bar
	package Foo;
	DESTROY { die "foo bar" }
	{ bless [], 'Foo' for 1..10 }

__END__
# pp_ctl.c
use warning 'syntax' ;
format STDOUT =
@<<< @<<<
1
.
write;
EXPECT
Not enough format arguments at - line 5.
1
########
# pp_ctl.c
no warning 'syntax' ;
format =
@<<< @<<<
1
.
write ;
EXPECT
1
########
# pp_ctl.c
use warning 'unsafe' ;
$_ = "abc" ;
 
while ($i ++ == 0)
{
    s/ab/last/e ;
}
no warning 'unsafe' ;
while ($i ++ == 0)
{
    s/ab/last/e ;
}
EXPECT
Exiting substitution via last at - line 7.
########
# pp_ctl.c
use warning 'unsafe' ;
sub fred { last }
{ fred() }
no warning 'unsafe' ;
sub joe { last }
{ joe() }
EXPECT
Exiting subroutine via last at - line 3.
########
# pp_ctl.c
{
  eval "use warning 'unsafe' ; last;" 
}
print STDERR $@ ;
{
  eval "no warning 'unsafe' ;last;" 
} 
print STDERR $@ ;
EXPECT
Exiting eval via last at (eval 1) line 1.
########
# pp_ctl.c
use warning 'unsafe' ;
@a = (1,2) ;
@b = sort { last } @a ;
no warning 'unsafe' ;
@b = sort { last } @a ;
EXPECT
Exiting pseudo-block via last at - line 4.
Can't "last" outside a block at - line 4.
########
# pp_ctl.c
use warning 'unsafe' ;
$_ = "abc" ;
fred: 
while ($i ++ == 0)
{
    s/ab/last fred/e ;
}
no warning 'unsafe' ;
while ($i ++ == 0)
{
    s/ab/last fred/e ;
}
EXPECT
Exiting substitution via last at - line 7.
########
# pp_ctl.c
use warning 'unsafe' ;
sub fred { last joe }
joe: { fred() }
no warning 'unsafe' ;
sub Fred { last Joe }
Joe: { Fred() }
EXPECT
Exiting subroutine via last at - line 3.
########
# pp_ctl.c
joe:
{ eval "use warning 'unsafe' ; last joe;" }
print STDERR $@ ;
Joe:
{ eval "no warning 'unsafe' ; last Joe;" }
print STDERR $@ ;
EXPECT
Exiting eval via last at (eval 1) line 1.
########
# pp_ctl.c
use warning 'unsafe' ;
@a = (1,2) ;
fred: @b = sort { last fred } @a ;
no warning 'unsafe' ;
Fred: @b = sort { last Fred } @a ;
EXPECT
Exiting pseudo-block via last at - line 4.
Label not found for "last fred" at - line 4.
########
# pp_ctl.c
use warning 'recursion' ;
BEGIN { warn "PREFIX\n" ;}
sub fred
{
    goto &fred() if $a++ < 200
}
 
goto &fred()
EXPECT
Deep recursion on subroutine "main::fred" at - line 6.
########
# pp_ctl.c
no warning 'recursion' ;
BEGIN { warn "PREFIX\n" ;}
sub fred
{
    goto &fred() if $a++ < 200
}
 
goto &fred()
EXPECT
Can't find label
########
# pp_ctl.c
use warning 'unsafe' ;
package Foo;
DESTROY { die "@{$_[0]} foo bar" }
{ bless ['A'], 'Foo' for 1..10 }
{ bless ['B'], 'Foo' for 1..10 }
EXPECT
	(in cleanup) A foo bar at - line 4.
	(in cleanup) B foo bar at - line 4.
########
# pp_ctl.c
no warning 'unsafe' ;
package Foo;
DESTROY { die "@{$_[0]} foo bar" }
{ bless ['A'], 'Foo' for 1..10 }
{ bless ['B'], 'Foo' for 1..10 }
EXPECT
Commit	Line	Data
599cee73	1	pp_ctl.c AOK
	2
	3	Not enough format arguments
	4	format STDOUT =
	5	@<<< @<<<
	6	$a
	7	.
	8	write;
	9
	10
	11	Exiting substitution via %s
	12	$_ = "abc" ;
	13	while ($i ++ == 0)
	14	{
	15	s/ab/last/e ;
	16	}
	17
	18	Exiting subroutine via %s
	19	sub fred { last }
	20	{ fred() }
	21
	22	Exiting eval via %s
	23	{ eval "last" }
	24
	25	Exiting pseudo-block via %s
	26	@a = (1,2) ; @b = sort { last } @a ;
	27
	28	Exiting substitution via %s
	29	$_ = "abc" ;
	30	last fred:
	31	while ($i ++ == 0)
	32	{
	33	s/ab/last fred/e ;
	34	}
	35
	36
	37	Exiting subroutine via %s
	38	sub fred { last joe }
	39	joe: { fred() }
	40
	41	Exiting eval via %s
	42	fred: { eval "last fred" }
	43
	44	Exiting pseudo-block via %s
	45	@a = (1,2) ; fred: @b = sort { last fred } @a ;
	46
	47
	48	Deep recursion on subroutine \"%s\"
	49	sub fred
	50	{
	51	goto &fred() if $a++ < 200
	52	}
	53
	54	goto &fred()
	55
a99e4ac2	56	(in cleanup) foo bar
	57	package Foo;
	58	DESTROY { die "foo bar" }
	59	{ bless [], 'Foo' for 1..10 }
599cee73	60
	61	__END__
	62	# pp_ctl.c
	63	use warning 'syntax' ;
	64	format STDOUT =
	65	@<<< @<<<
	66	1
	67	.
	68	write;
	69	EXPECT
	70	Not enough format arguments at - line 5.
	71	1
	72	########
	73	# pp_ctl.c
0453d815	74	no warning 'syntax' ;
	75	format =
	76	@<<< @<<<
	77	1
	78	.
	79	write ;
	80	EXPECT
	81	1
	82	########
	83	# pp_ctl.c
599cee73	84	use warning 'unsafe' ;
	85	$_ = "abc" ;
	86
	87	while ($i ++ == 0)
	88	{
	89	s/ab/last/e ;
	90	}
0453d815	91	no warning 'unsafe' ;
	92	while ($i ++ == 0)
	93	{
	94	s/ab/last/e ;
	95	}
599cee73	96	EXPECT
	97	Exiting substitution via last at - line 7.
	98	########
	99	# pp_ctl.c
	100	use warning 'unsafe' ;
	101	sub fred { last }
	102	{ fred() }
0453d815	103	no warning 'unsafe' ;
	104	sub joe { last }
	105	{ joe() }
599cee73	106	EXPECT
	107	Exiting subroutine via last at - line 3.
	108	########
	109	# pp_ctl.c
0453d815	110	{
	111	eval "use warning 'unsafe' ; last;"
	112	}
	113	print STDERR $@ ;
	114	{
	115	eval "no warning 'unsafe' ;last;"
	116	}
599cee73	117	print STDERR $@ ;
	118	EXPECT
	119	Exiting eval via last at (eval 1) line 1.
	120	########
	121	# pp_ctl.c
	122	use warning 'unsafe' ;
	123	@a = (1,2) ;
	124	@b = sort { last } @a ;
0453d815	125	no warning 'unsafe' ;
0453d815	126	@b = sort { last } @a ;
599cee73	127	EXPECT
	128	Exiting pseudo-block via last at - line 4.
	129	Can't "last" outside a block at - line 4.
	130	########
	131	# pp_ctl.c
	132	use warning 'unsafe' ;
	133	$_ = "abc" ;
	134	fred:
	135	while ($i ++ == 0)
	136	{
	137	s/ab/last fred/e ;
	138	}
0453d815	139	no warning 'unsafe' ;
	140	while ($i ++ == 0)
	141	{
	142	s/ab/last fred/e ;
	143	}
599cee73	144	EXPECT
	145	Exiting substitution via last at - line 7.
	146	########
	147	# pp_ctl.c
	148	use warning 'unsafe' ;
	149	sub fred { last joe }
	150	joe: { fred() }
0453d815	151	no warning 'unsafe' ;
	152	sub Fred { last Joe }
	153	Joe: { Fred() }
599cee73	154	EXPECT
	155	Exiting subroutine via last at - line 3.
	156	########
	157	# pp_ctl.c
0453d815	158	joe:
	159	{ eval "use warning 'unsafe' ; last joe;" }
	160	print STDERR $@ ;
	161	Joe:
	162	{ eval "no warning 'unsafe' ; last Joe;" }
599cee73	163	print STDERR $@ ;
599cee73	164	EXPECT
60e6418e	165	Exiting eval via last at (eval 1) line 1.
599cee73	166	########
	167	# pp_ctl.c
	168	use warning 'unsafe' ;
	169	@a = (1,2) ;
	170	fred: @b = sort { last fred } @a ;
0453d815	171	no warning 'unsafe' ;
0453d815	172	Fred: @b = sort { last Fred } @a ;
599cee73	173	EXPECT
	174	Exiting pseudo-block via last at - line 4.
	175	Label not found for "last fred" at - line 4.
	176	########
	177	# pp_ctl.c
	178	use warning 'recursion' ;
	179	BEGIN { warn "PREFIX\n" ;}
	180	sub fred
	181	{
	182	goto &fred() if $a++ < 200
	183	}
	184
	185	goto &fred()
	186	EXPECT
	187	Deep recursion on subroutine "main::fred" at - line 6.
a99e4ac2	188	########
a99e4ac2	189	# pp_ctl.c
0453d815	190	no warning 'recursion' ;
	191	BEGIN { warn "PREFIX\n" ;}
	192	sub fred
	193	{
	194	goto &fred() if $a++ < 200
	195	}
	196
	197	goto &fred()
	198	EXPECT
	199	Can't find label
	200	########
	201	# pp_ctl.c
a99e4ac2	202	use warning 'unsafe' ;
	203	package Foo;
	204	DESTROY { die "@{$_[0]} foo bar" }
	205	{ bless ['A'], 'Foo' for 1..10 }
b5d92ff4	206	{ bless ['B'], 'Foo' for 1..10 }
a99e4ac2	207	EXPECT
a99e4ac2	208	(in cleanup) A foo bar at - line 4.
b5d92ff4	209	(in cleanup) B foo bar at - line 4.
0453d815	210	########
	211	# pp_ctl.c
	212	no warning 'unsafe' ;
	213	package Foo;
	214	DESTROY { die "@{$_[0]} foo bar" }
	215	{ bless ['A'], 'Foo' for 1..10 }
	216	{ bless ['B'], 'Foo' for 1..10 }
	217	EXPECT
	218