diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 2001-06-18 04:17:15 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-06-18 04:17:15 +0000 |
commit | b695f709e8a342e35e482b0437eb6cdacdc58b6b (patch) | |
tree | 2d16192636e6ba806ff7a907f682c74f7705a920 /t/pragma/constant.t | |
parent | d780cd7a0195e946e636d3ee546f6ef4f21d6acc (diff) | |
download | perl-b695f709e8a342e35e482b0437eb6cdacdc58b6b.tar.gz |
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
Diffstat (limited to 't/pragma/constant.t')
-rwxr-xr-x | t/pragma/constant.t | 251 |
1 files changed, 0 insertions, 251 deletions
diff --git a/t/pragma/constant.t b/t/pragma/constant.t deleted file mode 100755 index f932976f60..0000000000 --- a/t/pragma/constant.t +++ /dev/null @@ -1,251 +0,0 @@ -#!./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]; |