1 files changed, 319 insertions, 0 deletions
diff --git a/lib/strict/subs b/lib/strict/subs
new file mode 100644
index 0000000000..ed4fe7a443
--- /dev/null
+++ b/lib/strict/subs
@@ -0,0 +1,319 @@
+Check strict subs functionality
+
+__END__
+
+# no strict, should build & run ok.
+Fred ;
+my $fred ;
+$b = "fred" ;
+$a = $$b ;
+EXPECT
+
+########
+
+use strict qw(refs vars);
+Fred ;
+EXPECT
+
+########
+
+use strict ;
+no strict 'subs' ;
+Fred ;
+EXPECT
+
+########
+
+# strict subs - error
+use strict 'subs' ;
+Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict subs - error
+use strict 'subs' ;
+my @a = (A..Z);
+EXPECT
+Bareword "Z" not allowed while "strict subs" in use at - line 4.
+Bareword "A" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict subs - error
+use strict 'subs' ;
+my $a = (B..Y);
+EXPECT
+Bareword "Y" not allowed while "strict subs" in use at - line 4.
+Bareword "B" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict subs - error
+use strict ;
+Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict subs - no error
+use strict 'subs' ;
+sub Fred {}
+Fred ;
+EXPECT
+
+########
+
+# Check compile time scope of strict subs pragma
+use strict 'subs' ;
+{
+    no strict ;
+    my $a = Fred ;
+}
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict subs pragma
+no strict;
+{
+    use strict 'subs' ;
+    my $a = Fred ;
+}
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 6.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict vars pragma
+use strict 'vars' ;
+{
+    no strict ;
+    $joe = 1 ;
+}
+$joe = 1 ;
+EXPECT
+Variable "$joe" is not imported at - line 8.
+Global symbol "$joe" requires explicit package name at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict vars pragma
+no strict;
+{
+    use strict 'vars' ;
+    $joe = 1 ;
+}
+$joe = 1 ;
+EXPECT
+Global symbol "$joe" requires explicit package name at - line 6.
+Execution of - aborted due to compilation errors.
+########
+
+# Check runtime scope of strict refs pragma
+use strict 'refs';
+my $fred ;
+my $b = "fred" ;
+{
+    no strict ;
+    my $a = $$b ;
+}
+my $a = $$b ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 10.
+########
+
+# Check runtime scope of strict refs pragma
+no strict ;
+my $fred ;
+my $b = "fred" ;
+{
+    use strict 'refs' ;
+    my $a = $$b ;
+}
+my $a = $$b ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
+########
+
+# Check runtime scope of strict refs pragma
+no strict ;
+my $fred ;
+my $b = "fred" ;
+{
+    use strict 'refs' ;
+    $a = sub { my $c = $$b ; }
+}
+&$a ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
+########
+
+use strict 'subs' ;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 3.
+Execution of - aborted due to compilation errors.
+########
+
+--FILE-- abc
+my $a = Fred ;
+1;
+--FILE-- 
+use strict 'subs' ;
+require "./abc";
+EXPECT
+
+########
+
+--FILE-- abc
+use strict 'subs' ;
+1;
+--FILE-- 
+require "./abc";
+my $a = Fred ;
+EXPECT
+
+########
+
+--FILE-- abc
+use strict 'subs' ;
+my $a = Fred ;
+1;
+--FILE-- 
+Fred ;
+require "./abc";
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at ./abc line 2.
+Compilation failed in require at - line 2.
+########
+
+--FILE-- abc.pm
+use strict 'subs' ;
+my $a = Fred ;
+1;
+--FILE-- 
+Fred ;
+use abc;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at abc.pm line 2.
+Compilation failed in require at - line 2.
+BEGIN failed--compilation aborted at - line 2.
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval {
+    my $a = Fred ;
+};
+print STDERR $@;
+my $a = Fred ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval {
+    use strict 'subs' ;
+    my $a = Fred ;
+};
+print STDERR $@;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 6.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+use strict 'subs' ;
+eval {
+    my $a = Fred ;
+};
+print STDERR $@;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 5.
+Bareword "Fred" not allowed while "strict subs" in use at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+use strict 'subs' ;
+eval {
+    no strict ;
+    my $a = Fred ;
+};
+print STDERR $@;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 9.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval '
+    Fred ;
+'; print STDERR $@ ;
+Fred ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval q[ 
+    use strict 'subs' ;
+    Fred ;
+]; print STDERR $@;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+use strict 'subs' ;
+eval '
+    Fred ;
+'; print STDERR $@ ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at (eval 1) line 2.
+########
+
+# Check scope of pragma with eval
+use strict 'subs' ;
+eval '
+    no strict ;
+    my $a = Fred ;
+'; print STDERR $@;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# see if Foo->Bar(...) etc work under strictures
+use strict;
+package Foo; sub Bar { print "@_\n" }
+Foo->Bar('a',1);
+Bar Foo ('b',2);
+Foo->Bar(qw/c 3/);
+Bar Foo (qw/d 4/);
+Foo::->Bar('A',1);
+Bar Foo:: ('B',2);
+Foo::->Bar(qw/C 3/);
+Bar Foo:: (qw/D 4/);
+EXPECT
+Foo a 1
+Foo b 2
+Foo c 3
+Foo d 4
+Foo A 1
+Foo B 2
+Foo C 3
+Foo D 4