The Grand Trek: move the *.t files from t/ to lib/ and ext/.

No doubt I made some mistakes like missed some files or
misnamed some files.  The naming rules were more or less:
(1) if the module is from CPAN, follows its ways, be it
    t/*.t or test.pl.
(2) otherwise if there are multiple tests for a module
    put them in a t/
(3) otherwise if there's only one test put it in Module.t
(4) helper files go to module/ (locale, strict, warnings)
(5) use longer filenames now that we can (but e.g. the
    compat-0.6.t and the Text::Balanced test files still
    were renamed to be more civil against the 8.3 people)
installperl was updated appropriately not to install the
*.t files or the help files from under lib.

TODO: some helper files still remain under t/ that could
follow their 'masters'.  UPDATE: On second thoughts, why
should they.  They can continue to live under t/lib, and
in fact the locale/strict/warnings helpers that were moved
could be moved back.  This way the amount of non-installable
stuff under lib/ stays smaller.

p4raw-id: //depot/perl@10676

1 files changed, 251 insertions, 0 deletions

diff --git a/lib/constant.t b/lib/constant.t
new file mode 100644
index 0000000000..f932976f60
--- /dev/null
+++ b/lib/constant.t
@@ -0,0 +1,251 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use warnings;
+use vars qw{ @warnings };
+BEGIN {				# ...and save 'em for later
+    $SIG{'__WARN__'} = sub { push @warnings, @_ }
+}
+END { print @warnings }
+
+######################### We start with some black magic to print on failure.
+
+BEGIN { $| = 1; print "1..82\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use constant 1.01;
+$loaded = 1;
+#print "# Version: $constant::VERSION\n";
+print "ok 1\n";
+
+######################### End of black magic.
+
+use strict;
+
+sub test ($$;$) {
+    my($num, $bool, $diag) = @_;
+    if ($bool) {
+	print "ok $num\n";
+	return;
+    }
+    print "not ok $num\n";
+    return unless defined $diag;
+    $diag =~ s/\Z\n?/\n/;			# unchomp
+    print map "# $num : $_", split m/^/m, $diag;
+}
+
+use constant PI		=> 4 * atan2 1, 1;
+
+test 2, substr(PI, 0, 7) eq '3.14159';
+test 3, defined PI;
+
+sub deg2rad { PI * $_[0] / 180 }
+
+my $ninety = deg2rad 90;
+
+test 4, $ninety > 1.5707;
+test 5, $ninety < 1.5708;
+
+use constant UNDEF1	=> undef;	# the right way
+use constant UNDEF2	=>	;	# the weird way
+use constant 'UNDEF3'		;	# the 'short' way
+use constant EMPTY	=> ( )  ;	# the right way for lists
+
+test 6, not defined UNDEF1;
+test 7, not defined UNDEF2;
+test 8, not defined UNDEF3;
+my @undef = UNDEF1;
+test 9, @undef == 1;
+test 10, not defined $undef[0];
+@undef = UNDEF2;
+test 11, @undef == 0;
+@undef = UNDEF3;
+test 12, @undef == 0;
+@undef = EMPTY;
+test 13, @undef == 0;
+
+use constant COUNTDOWN	=> scalar reverse 1, 2, 3, 4, 5;
+use constant COUNTLIST	=> reverse 1, 2, 3, 4, 5;
+use constant COUNTLAST	=> (COUNTLIST)[-1];
+
+test 14, COUNTDOWN eq '54321';
+my @cl = COUNTLIST;
+test 15, @cl == 5;
+test 16, COUNTDOWN eq join '', @cl;
+test 17, COUNTLAST == 1;
+test 18, (COUNTLIST)[1] == 4;
+
+use constant ABC	=> 'ABC';
+test 19, "abc${\( ABC )}abc" eq "abcABCabc";
+
+use constant DEF	=> 'D', 'E', chr ord 'F';
+test 20, "d e f @{[ DEF ]} d e f" eq "d e f D E F d e f";
+
+use constant SINGLE	=> "'";
+use constant DOUBLE	=> '"';
+use constant BACK	=> '\\';
+my $tt = BACK . SINGLE . DOUBLE ;
+test 21, $tt eq q(\\'");
+
+use constant MESS	=> q('"'\\"'"\\);
+test 22, MESS eq q('"'\\"'"\\);
+test 23, length(MESS) == 8;
+
+use constant TRAILING	=> '12 cats';
+{
+    no warnings 'numeric';
+    test 24, TRAILING == 12;
+}
+test 25, TRAILING eq '12 cats';
+
+use constant LEADING	=> " \t1234";
+test 26, LEADING == 1234;
+test 27, LEADING eq " \t1234";
+
+use constant ZERO1	=> 0;
+use constant ZERO2	=> 0.0;
+use constant ZERO3	=> '0.0';
+test 28, ZERO1 eq '0';
+test 29, ZERO2 eq '0';
+test 30, ZERO3 eq '0.0';
+
+{
+    package Other;
+    use constant PI	=> 3.141;
+}
+
+test 31, (PI > 3.1415 and PI < 3.1416);
+test 32, Other::PI == 3.141;
+
+use constant E2BIG => $! = 7;
+test 33, E2BIG == 7;
+# This is something like "Arg list too long", but the actual message
+# text may vary, so we can't test much better than this.
+test 34, length(E2BIG) > 6;
+test 35, index(E2BIG, " ") > 0;
+
+test 36, @warnings == 0, join "\n", "unexpected warning", @warnings;
+@warnings = ();		# just in case
+undef &PI;
+test 37, @warnings &&
+    ($warnings[0] =~ /Constant sub.* undefined/),
+    shift @warnings;
+
+test 38, @warnings == 0, "unexpected warning";
+test 39, 1;
+
+use constant CSCALAR	=> \"ok 40\n";
+use constant CHASH	=> { foo => "ok 41\n" };
+use constant CARRAY	=> [ undef, "ok 42\n" ];
+use constant CPHASH	=> [ { foo => 1 }, "ok 43\n" ];
+use constant CCODE	=> sub { "ok $_[0]\n" };
+
+print ${+CSCALAR};
+print CHASH->{foo};
+print CARRAY->[1];
+print CPHASH->{foo};
+eval q{ CPHASH->{bar} };
+test 44, scalar($@ =~ /^No such pseudo-hash field/);
+print CCODE->(45);
+eval q{ CCODE->{foo} };
+test 46, scalar($@ =~ /^Constant is not a HASH/);
+
+# Allow leading underscore
+use constant _PRIVATE => 47;
+test 47, _PRIVATE == 47;
+
+# Disallow doubled leading underscore
+eval q{
+    use constant __DISALLOWED => "Oops";
+};
+test 48, $@ =~ /begins with '__'/;
+
+# Check on declared() and %declared. This sub should be EXACTLY the
+# same as the one quoted in the docs!
+sub declared ($) {
+    use constant 1.01;              # don't omit this!
+    my $name = shift;
+    $name =~ s/^::/main::/;
+    my $pkg = caller;
+    my $full_name = $name =~ /::/ ? $name : "${pkg}::$name";
+    $constant::declared{$full_name};
+}
+
+test 49, declared 'PI';
+test 50, $constant::declared{'main::PI'};
+
+test 51, !declared 'PIE';
+test 52, !$constant::declared{'main::PIE'};
+
+{
+    package Other;
+    use constant IN_OTHER_PACK => 42;
+    ::test 53, ::declared 'IN_OTHER_PACK';
+    ::test 54, $constant::declared{'Other::IN_OTHER_PACK'};
+    ::test 55, ::declared 'main::PI';
+    ::test 56, $constant::declared{'main::PI'};
+}
+
+test 57, declared 'Other::IN_OTHER_PACK';
+test 58, $constant::declared{'Other::IN_OTHER_PACK'};
+
+@warnings = ();
+eval q{
+    no warnings;
+    use warnings 'constant';
+    use constant 'BEGIN' => 1 ;
+    use constant 'INIT' => 1 ;
+    use constant 'CHECK' => 1 ;
+    use constant 'END' => 1 ;
+    use constant 'DESTROY' => 1 ;
+    use constant 'AUTOLOAD' => 1 ;
+    use constant 'STDIN' => 1 ;
+    use constant 'STDOUT' => 1 ;
+    use constant 'STDERR' => 1 ;
+    use constant 'ARGV' => 1 ;
+    use constant 'ARGVOUT' => 1 ;
+    use constant 'ENV' => 1 ;
+    use constant 'INC' => 1 ;
+    use constant 'SIG' => 1 ;
+};
+
+test 59, @warnings == 15 ;
+test 60, (shift @warnings) =~ /^Constant name 'BEGIN' is a Perl keyword at/;
+shift @warnings; #Constant subroutine BEGIN redefined at
+test 61, (shift @warnings) =~ /^Constant name 'INIT' is a Perl keyword at/;
+test 62, (shift @warnings) =~ /^Constant name 'CHECK' is a Perl keyword at/;
+test 63, (shift @warnings) =~ /^Constant name 'END' is a Perl keyword at/;
+test 64, (shift @warnings) =~ /^Constant name 'DESTROY' is a Perl keyword at/;
+test 65, (shift @warnings) =~ /^Constant name 'AUTOLOAD' is a Perl keyword at/;
+test 66, (shift @warnings) =~ /^Constant name 'STDIN' is forced into package main:: a/;
+test 67, (shift @warnings) =~ /^Constant name 'STDOUT' is forced into package main:: at/;
+test 68, (shift @warnings) =~ /^Constant name 'STDERR' is forced into package main:: at/;
+test 69, (shift @warnings) =~ /^Constant name 'ARGV' is forced into package main:: at/;
+test 70, (shift @warnings) =~ /^Constant name 'ARGVOUT' is forced into package main:: at/;
+test 71, (shift @warnings) =~ /^Constant name 'ENV' is forced into package main:: at/;
+test 72, (shift @warnings) =~ /^Constant name 'INC' is forced into package main:: at/;
+test 73, (shift @warnings) =~ /^Constant name 'SIG' is forced into package main:: at/;
+@warnings = ();
+
+
+use constant {
+	THREE  => 3,
+	FAMILY => [ qw( John Jane Sally ) ],
+	AGES   => { John => 33, Jane => 28, Sally => 3 },
+	RFAM   => [ [ qw( John Jane Sally ) ] ],
+	SPIT   => sub { shift },
+	PHFAM  => [ { John => 1, Jane => 2, Sally => 3 }, 33, 28, 3 ],
+};
+
+test 74, @{+FAMILY} == THREE;
+test 75, @{+FAMILY} == @{RFAM->[0]};
+test 76, FAMILY->[2] eq RFAM->[0]->[2];
+test 77, AGES->{FAMILY->[1]} == 28;
+test 78, PHFAM->{John} == AGES->{John};
+test 79, PHFAM->[3] == AGES->{FAMILY->[2]};
+test 80, @{+PHFAM} == SPIT->(THREE+1);
+test 81, THREE**3 eq SPIT->(@{+FAMILY}**3);
+test 82, AGES->{FAMILY->[THREE-1]} == PHFAM->[THREE];