summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2009-09-28 13:49:33 +0100
committerNicholas Clark <nick@ccl4.org>2009-09-29 11:12:37 +0100
commitf2d32da304293624412eaca03324da35a39c9f5e (patch)
tree0d40bcd4797bf7cf6fa8d4bc20204be9b9c90bf9 /ext
parent70361a71ff3810e2a1c0d257139ec1323e57ebfa (diff)
downloadperl-f2d32da304293624412eaca03324da35a39c9f5e.tar.gz
Move constant from ext/ to dist/
Diffstat (limited to 'ext')
-rw-r--r--ext/constant/lib/constant.pm392
-rw-r--r--ext/constant/t/constant.t343
2 files changed, 0 insertions, 735 deletions
diff --git a/ext/constant/lib/constant.pm b/ext/constant/lib/constant.pm
deleted file mode 100644
index a51ee7f277..0000000000
--- a/ext/constant/lib/constant.pm
+++ /dev/null
@@ -1,392 +0,0 @@
-package constant;
-use 5.005;
-use strict;
-use warnings::register;
-
-use vars qw($VERSION %declared);
-$VERSION = '1.19';
-
-#=======================================================================
-
-# Some names are evil choices.
-my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD };
-$keywords{UNITCHECK}++ if $] > 5.009;
-
-my %forced_into_main = map +($_, 1),
- qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG };
-
-my %forbidden = (%keywords, %forced_into_main);
-
-my $str_end = $] >= 5.006 ? "\\z" : "\\Z";
-my $normal_constant_name = qr/^_?[^\W_0-9]\w*$str_end/;
-my $tolerable = qr/^[A-Za-z_]\w*$str_end/;
-my $boolean = qr/^[01]?$str_end/;
-
-BEGIN {
- # We'd like to do use constant _CAN_PCS => $] > 5.009002
- # but that's a bit tricky before we load the constant module :-)
- # By doing this, we save 1 run time check for *every* call to import.
- no strict 'refs';
- my $const = $] > 5.009002;
- *_CAN_PCS = sub () {$const};
-}
-
-#=======================================================================
-# import() - import symbols into user's namespace
-#
-# What we actually do is define a function in the caller's namespace
-# which returns the value. The function we create will normally
-# be inlined as a constant, thereby avoiding further sub calling
-# overhead.
-#=======================================================================
-sub import {
- my $class = shift;
- return unless @_; # Ignore 'use constant;'
- my $constants;
- my $multiple = ref $_[0];
- my $pkg = caller;
- my $flush_mro;
- my $symtab;
-
- if (_CAN_PCS) {
- no strict 'refs';
- $symtab = \%{$pkg . '::'};
- };
-
- if ( $multiple ) {
- if (ref $_[0] ne 'HASH') {
- require Carp;
- Carp::croak("Invalid reference type '".ref(shift)."' not 'HASH'");
- }
- $constants = shift;
- } else {
- $constants->{+shift} = undef;
- }
-
- foreach my $name ( keys %$constants ) {
- unless (defined $name) {
- require Carp;
- Carp::croak("Can't use undef as constant name");
- }
-
- # Normal constant name
- if ($name =~ $normal_constant_name and !$forbidden{$name}) {
- # Everything is okay
-
- # Name forced into main, but we're not in main. Fatal.
- } elsif ($forced_into_main{$name} and $pkg ne 'main') {
- require Carp;
- Carp::croak("Constant name '$name' is forced into main::");
-
- # Starts with double underscore. Fatal.
- } elsif ($name =~ /^__/) {
- require Carp;
- Carp::croak("Constant name '$name' begins with '__'");
-
- # Maybe the name is tolerable
- } elsif ($name =~ $tolerable) {
- # Then we'll warn only if you've asked for warnings
- if (warnings::enabled()) {
- if ($keywords{$name}) {
- warnings::warn("Constant name '$name' is a Perl keyword");
- } elsif ($forced_into_main{$name}) {
- warnings::warn("Constant name '$name' is " .
- "forced into package main::");
- }
- }
-
- # Looks like a boolean
- # use constant FRED == fred;
- } elsif ($name =~ $boolean) {
- require Carp;
- if (@_) {
- Carp::croak("Constant name '$name' is invalid");
- } else {
- Carp::croak("Constant name looks like boolean value");
- }
-
- } else {
- # Must have bad characters
- require Carp;
- Carp::croak("Constant name '$name' has invalid characters");
- }
-
- {
- no strict 'refs';
- my $full_name = "${pkg}::$name";
- $declared{$full_name}++;
- if ($multiple || @_ == 1) {
- my $scalar = $multiple ? $constants->{$name} : $_[0];
- # The constant serves to optimise this entire block out on
- # 5.8 and earlier.
- if (_CAN_PCS && $symtab && !exists $symtab->{$name}) {
- # No typeglob yet, so we can use a reference as space-
- # efficient proxy for a constant subroutine
- # The check in Perl_ck_rvconst knows that inlinable
- # constants from cv_const_sv are read only. So we have to:
- Internals::SvREADONLY($scalar, 1);
- $symtab->{$name} = \$scalar;
- ++$flush_mro;
- } else {
- *$full_name = sub () { $scalar };
- }
- } elsif (@_) {
- my @list = @_;
- *$full_name = sub () { @list };
- } else {
- *$full_name = sub () { };
- }
- }
- }
- # Flush the cache exactly once if we make any direct symbol table changes.
- mro::method_changed_in($pkg) if _CAN_PCS && $flush_mro;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-constant - Perl pragma to declare constants
-
-=head1 SYNOPSIS
-
- use constant PI => 4 * atan2(1, 1);
- use constant DEBUG => 0;
-
- print "Pi equals ", PI, "...\n" if DEBUG;
-
- use constant {
- SEC => 0,
- MIN => 1,
- HOUR => 2,
- MDAY => 3,
- MON => 4,
- YEAR => 5,
- WDAY => 6,
- YDAY => 7,
- ISDST => 8,
- };
-
- use constant WEEKDAYS => qw(
- Sunday Monday Tuesday Wednesday Thursday Friday Saturday
- );
-
- print "Today is ", (WEEKDAYS)[ (localtime)[WDAY] ], ".\n";
-
-=head1 DESCRIPTION
-
-This pragma allows you to declare constants at compile-time.
-
-When you declare a constant such as C<PI> using the method shown
-above, each machine your script runs upon can have as many digits
-of accuracy as it can use. Also, your program will be easier to
-read, more likely to be maintained (and maintained correctly), and
-far less likely to send a space probe to the wrong planet because
-nobody noticed the one equation in which you wrote C<3.14195>.
-
-When a constant is used in an expression, Perl replaces it with its
-value at compile time, and may then optimize the expression further.
-In particular, any code in an C<if (CONSTANT)> block will be optimized
-away if the constant is false.
-
-=head1 NOTES
-
-As with all C<use> directives, defining a constant happens at
-compile time. Thus, it's probably not correct to put a constant
-declaration inside of a conditional statement (like C<if ($foo)
-{ use constant ... }>).
-
-Constants defined using this module cannot be interpolated into
-strings like variables. However, concatenation works just fine:
-
- print "Pi equals PI...\n"; # WRONG: does not expand "PI"
- print "Pi equals ".PI."...\n"; # right
-
-Even though a reference may be declared as a constant, the reference may
-point to data which may be changed, as this code shows.
-
- use constant ARRAY => [ 1,2,3,4 ];
- print ARRAY->[1];
- ARRAY->[1] = " be changed";
- print ARRAY->[1];
-
-Dereferencing constant references incorrectly (such as using an array
-subscript on a constant hash reference, or vice versa) will be trapped at
-compile time.
-
-Constants belong to the package they are defined in. To refer to a
-constant defined in another package, specify the full package name, as
-in C<Some::Package::CONSTANT>. Constants may be exported by modules,
-and may also be called as either class or instance methods, that is,
-as C<< Some::Package->CONSTANT >> or as C<< $obj->CONSTANT >> where
-C<$obj> is an instance of C<Some::Package>. Subclasses may define
-their own constants to override those in their base class.
-
-The use of all caps for constant names is merely a convention,
-although it is recommended in order to make constants stand out
-and to help avoid collisions with other barewords, keywords, and
-subroutine names. Constant names must begin with a letter or
-underscore. Names beginning with a double underscore are reserved. Some
-poor choices for names will generate warnings, if warnings are enabled at
-compile time.
-
-=head2 List constants
-
-Constants may be lists of more (or less) than one value. A constant
-with no values evaluates to C<undef> in scalar context. Note that
-constants with more than one value do I<not> return their last value in
-scalar context as one might expect. They currently return the number
-of values, but B<this may change in the future>. Do not use constants
-with multiple values in scalar context.
-
-B<NOTE:> This implies that the expression defining the value of a
-constant is evaluated in list context. This may produce surprises:
-
- use constant TIMESTAMP => localtime; # WRONG!
- use constant TIMESTAMP => scalar localtime; # right
-
-The first line above defines C<TIMESTAMP> as a 9-element list, as
-returned by C<localtime()> in list context. To set it to the string
-returned by C<localtime()> in scalar context, an explicit C<scalar>
-keyword is required.
-
-List constants are lists, not arrays. To index or slice them, they
-must be placed in parentheses.
-
- my @workdays = WEEKDAYS[1 .. 5]; # WRONG!
- my @workdays = (WEEKDAYS)[1 .. 5]; # right
-
-=head2 Defining multiple constants at once
-
-Instead of writing multiple C<use constant> statements, you may define
-multiple constants in a single statement by giving, instead of the
-constant name, a reference to a hash where the keys are the names of
-the constants to be defined. Obviously, all constants defined using
-this method must have a single value.
-
- use constant {
- FOO => "A single value",
- BAR => "This", "won't", "work!", # Error!
- };
-
-This is a fundamental limitation of the way hashes are constructed in
-Perl. The error messages produced when this happens will often be
-quite cryptic -- in the worst case there may be none at all, and
-you'll only later find that something is broken.
-
-When defining multiple constants, you cannot use the values of other
-constants defined in the same declaration. This is because the
-calling package doesn't know about any constant within that group
-until I<after> the C<use> statement is finished.
-
- use constant {
- BITMASK => 0xAFBAEBA8,
- NEGMASK => ~BITMASK, # Error!
- };
-
-=head2 Magic constants
-
-Magical values and references can be made into constants at compile
-time, allowing for way cool stuff like this. (These error numbers
-aren't totally portable, alas.)
-
- use constant E2BIG => ($! = 7);
- print E2BIG, "\n"; # something like "Arg list too long"
- print 0+E2BIG, "\n"; # "7"
-
-You can't produce a tied constant by giving a tied scalar as the
-value. References to tied variables, however, can be used as
-constants without any problems.
-
-=head1 TECHNICAL NOTES
-
-In the current implementation, scalar constants are actually
-inlinable subroutines. As of version 5.004 of Perl, the appropriate
-scalar constant is inserted directly in place of some subroutine
-calls, thereby saving the overhead of a subroutine call. See
-L<perlsub/"Constant Functions"> for details about how and when this
-happens.
-
-In the rare case in which you need to discover at run time whether a
-particular constant has been declared via this module, you may use
-this function to examine the hash C<%constant::declared>. If the given
-constant name does not include a package name, the current package is
-used.
-
- 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};
- }
-
-=head1 CAVEATS
-
-In the current version of Perl, list constants are not inlined
-and some symbols may be redefined without generating a warning.
-
-It is not possible to have a subroutine or a keyword with the same
-name as a constant in the same package. This is probably a Good Thing.
-
-A constant with a name in the list C<STDIN STDOUT STDERR ARGV ARGVOUT
-ENV INC SIG> is not allowed anywhere but in package C<main::>, for
-technical reasons.
-
-Unlike constants in some languages, these cannot be overridden
-on the command line or via environment variables.
-
-You can get into trouble if you use constants in a context which
-automatically quotes barewords (as is true for any subroutine call).
-For example, you can't say C<$hash{CONSTANT}> because C<CONSTANT> will
-be interpreted as a string. Use C<$hash{CONSTANT()}> or
-C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from
-kicking in. Similarly, since the C<< => >> operator quotes a bareword
-immediately to its left, you have to say C<< CONSTANT() => 'value' >>
-(or simply use a comma in place of the big arrow) instead of
-C<< CONSTANT => 'value' >>.
-
-=head1 SEE ALSO
-
-L<Readonly> - Facility for creating read-only scalars, arrays, hashes.
-
-L<Const> - Facility for creating read-only variables. Similar to C<Readonly>,
-but uses C<SvREADONLY> instead of C<tie>.
-
-L<Attribute::Constant> - Make read-only variables via attribute
-
-L<Scalar::Readonly> - Perl extension to the C<SvREADONLY> scalar flag
-
-L<Hash::Util> - A selection of general-utility hash subroutines (mostly
-to lock/unlock keys and values)
-
-=head1 BUGS
-
-Please report any bugs or feature requests via the perlbug(1) utility.
-
-=head1 AUTHORS
-
-Tom Phoenix, E<lt>F<rootbeer@redcat.com>E<gt>, with help from
-many other folks.
-
-Multiple constant declarations at once added by Casey West,
-E<lt>F<casey@geeknest.com>E<gt>.
-
-Documentation mostly rewritten by Ilmari Karonen,
-E<lt>F<perl@itz.pp.sci.fi>E<gt>.
-
-This program is maintained by the Perl 5 Porters.
-The CPAN distribution is maintained by SE<eacute>bastien Aperghis-Tramoni
-E<lt>F<sebastien@aperghis.net>E<gt>.
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright (C) 1997, 1999 Tom Phoenix
-
-This module is free software; you can redistribute it or modify it
-under the same terms as Perl itself.
-
-=cut
diff --git a/ext/constant/t/constant.t b/ext/constant/t/constant.t
deleted file mode 100644
index a42b7d2281..0000000000
--- a/ext/constant/t/constant.t
+++ /dev/null
@@ -1,343 +0,0 @@
-#!./perl -T
-
-use warnings;
-use vars qw{ @warnings $fagwoosh $putt $kloong};
-BEGIN { # ...and save 'em for later
- $SIG{'__WARN__'} = sub { push @warnings, @_ }
-}
-END { @warnings && print STDERR join "\n- ", "accumulated warnings:", @warnings }
-
-
-use strict;
-use Test::More tests => 95;
-my $TB = Test::More->builder;
-
-BEGIN { use_ok('constant'); }
-
-use constant PI => 4 * atan2 1, 1;
-
-ok defined PI, 'basic scalar constant';
-is substr(PI, 0, 7), '3.14159', ' in substr()';
-
-sub deg2rad { PI * $_[0] / 180 }
-
-my $ninety = deg2rad 90;
-
-cmp_ok abs($ninety - 1.5707), '<', 0.0001, ' in math expression';
-
-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
-
-is UNDEF1, undef, 'right way to declare an undef';
-is UNDEF2, undef, ' weird way';
-is UNDEF3, undef, ' short way';
-
-# XXX Why is this way different than the other ones?
-my @undef = UNDEF1;
-is @undef, 1;
-is $undef[0], undef;
-
-@undef = UNDEF2;
-is @undef, 0;
-@undef = UNDEF3;
-is @undef, 0;
-@undef = EMPTY;
-is @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];
-
-is COUNTDOWN, '54321';
-my @cl = COUNTLIST;
-is @cl, 5;
-is COUNTDOWN, join '', @cl;
-is COUNTLAST, 1;
-is((COUNTLIST)[1], 4);
-
-use constant ABC => 'ABC';
-is "abc${\( ABC )}abc", "abcABCabc";
-
-use constant DEF => 'D', 'E', chr ord 'F';
-is "d e f @{[ DEF ]} d e f", "d e f D E F d e f";
-
-use constant SINGLE => "'";
-use constant DOUBLE => '"';
-use constant BACK => '\\';
-my $tt = BACK . SINGLE . DOUBLE ;
-is $tt, q(\\'");
-
-use constant MESS => q('"'\\"'"\\);
-is MESS, q('"'\\"'"\\);
-is length(MESS), 8;
-
-use constant LEADING => " \t1234";
-cmp_ok LEADING, '==', 1234;
-is LEADING, " \t1234";
-
-use constant ZERO1 => 0;
-use constant ZERO2 => 0.0;
-use constant ZERO3 => '0.0';
-is ZERO1, '0';
-is ZERO2, '0';
-is ZERO3, '0.0';
-
-{
- package Other;
- use constant PI => 3.141;
-}
-
-cmp_ok(abs(PI - 3.1416), '<', 0.0001);
-is Other::PI, 3.141;
-
-use constant E2BIG => $! = 7;
-cmp_ok 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.
-cmp_ok length(E2BIG), '>', 6;
-
-is @warnings, 0 or diag join "\n- ", "unexpected warning:", @warnings;
-@warnings = (); # just in case
-undef &PI;
-ok @warnings && ($warnings[0] =~ /Constant sub.* undefined/) or
- diag join "\n", "unexpected warning", @warnings;
-shift @warnings;
-
-is @warnings, 0, "unexpected warning";
-
-my $curr_test = $TB->current_test;
-use constant CSCALAR => \"ok 35\n";
-use constant CHASH => { foo => "ok 36\n" };
-use constant CARRAY => [ undef, "ok 37\n" ];
-use constant CCODE => sub { "ok $_[0]\n" };
-
-my $output = $TB->output ;
-print $output ${+CSCALAR};
-print $output CHASH->{foo};
-print $output CARRAY->[1];
-print $output CCODE->($curr_test+4);
-
-$TB->current_test($curr_test+4);
-
-eval q{ CCODE->{foo} };
-ok scalar($@ =~ /^Constant is not a HASH/);
-
-
-# Allow leading underscore
-use constant _PRIVATE => 47;
-is _PRIVATE, 47;
-
-# Disallow doubled leading underscore
-eval q{
- use constant __DISALLOWED => "Oops";
-};
-like $@, qr/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};
-}
-
-ok declared 'PI';
-ok $constant::declared{'main::PI'};
-
-ok !declared 'PIE';
-ok !$constant::declared{'main::PIE'};
-
-{
- package Other;
- use constant IN_OTHER_PACK => 42;
- ::ok ::declared 'IN_OTHER_PACK';
- ::ok $constant::declared{'Other::IN_OTHER_PACK'};
- ::ok ::declared 'main::PI';
- ::ok $constant::declared{'main::PI'};
-}
-
-ok declared 'Other::IN_OTHER_PACK';
-ok $constant::declared{'Other::IN_OTHER_PACK'};
-
-@warnings = ();
-eval q{
- no warnings;
- #local $^W if $] < 5.006;
- 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 ;
- use constant 'UNITCHECK' => 1;
-};
-
-my @Expected_Warnings =
- (
- qr/^Constant name 'BEGIN' is a Perl keyword at/,
- qr/^Constant subroutine BEGIN redefined at/,
- qr/^Constant name 'INIT' is a Perl keyword at/,
- qr/^Constant name 'CHECK' is a Perl keyword at/,
- qr/^Constant name 'END' is a Perl keyword at/,
- qr/^Constant name 'DESTROY' is a Perl keyword at/,
- qr/^Constant name 'AUTOLOAD' is a Perl keyword at/,
- qr/^Constant name 'STDIN' is forced into package main:: a/,
- qr/^Constant name 'STDOUT' is forced into package main:: at/,
- qr/^Constant name 'STDERR' is forced into package main:: at/,
- qr/^Constant name 'ARGV' is forced into package main:: at/,
- qr/^Constant name 'ARGVOUT' is forced into package main:: at/,
- qr/^Constant name 'ENV' is forced into package main:: at/,
- qr/^Constant name 'INC' is forced into package main:: at/,
- qr/^Constant name 'SIG' is forced into package main:: at/,
- qr/^Constant name 'UNITCHECK' is a Perl keyword at/,
-);
-
-unless ($] > 5.009) {
- # Remove the UNITCHECK warning
- pop @Expected_Warnings;
- # But keep the count the same
- push @Expected_Warnings, qr/^$/;
- push @warnings, "";
-}
-
-# when run under "make test"
-if (@warnings == 16) {
- push @warnings, "";
- push @Expected_Warnings, qr/^$/;
-}
-# when run directly: perl -wT -Ilib t/constant.t
-elsif (@warnings == 17) {
- splice @Expected_Warnings, 1, 0,
- qr/^Prototype mismatch: sub main::BEGIN \(\) vs none at/;
-}
-# when run directly under 5.6.2: perl -wT -Ilib t/constant.t
-elsif (@warnings == 15) {
- splice @Expected_Warnings, 1, 1;
- push @warnings, "", "";
- push @Expected_Warnings, qr/^$/, qr/^$/;
-}
-else {
- my $rule = " -" x 20;
- diag "/!\\ unexpected case: ", scalar @warnings, " warnings\n$rule\n";
- diag map { " $_" } @warnings;
- diag $rule, $/;
-}
-
-is @warnings, 17;
-
-for my $idx (0..$#warnings) {
- like $warnings[$idx], $Expected_Warnings[$idx];
-}
-
-@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 },
-};
-
-is @{+FAMILY}, THREE;
-is @{+FAMILY}, @{RFAM->[0]};
-is FAMILY->[2], RFAM->[0]->[2];
-is AGES->{FAMILY->[1]}, 28;
-is THREE**3, SPIT->(@{+FAMILY}**3);
-
-# Allow name of digits/underscores only if it begins with underscore
-{
- use warnings FATAL => 'constant';
- eval q{
- use constant _1_2_3 => 'allowed';
- };
- ok( $@ eq '' );
-}
-
-sub slotch ();
-
-{
- my @warnings;
- local $SIG{'__WARN__'} = sub { push @warnings, @_ };
- eval 'use constant slotch => 3; 1' or die $@;
-
- is ("@warnings", "", "No warnings if a prototype exists");
-
- my $value = eval 'slotch';
- is ($@, '');
- is ($value, 3);
-}
-
-sub zit;
-
-{
- my @warnings;
- local $SIG{'__WARN__'} = sub { push @warnings, @_ };
- eval 'use constant zit => 4; 1' or die $@;
-
- # empty prototypes are reported differently in different versions
- my $no_proto = $] < 5.008004 ? "" : ": none";
-
- is(scalar @warnings, 1, "1 warning");
- like ($warnings[0], qr/^Prototype mismatch: sub main::zit$no_proto vs \(\)/,
- "about the prototype mismatch");
-
- my $value = eval 'zit';
- is ($@, '');
- is ($value, 4);
-}
-
-$fagwoosh = 'geronimo';
-$putt = 'leutwein';
-$kloong = 'schlozhauer';
-
-{
- my @warnings;
- local $SIG{'__WARN__'} = sub { push @warnings, @_ };
- eval 'use constant fagwoosh => 5; 1' or die $@;
-
- is ("@warnings", "", "No warnings if the typeglob exists already");
-
- my $value = eval 'fagwoosh';
- is ($@, '');
- is ($value, 5);
-
- my @value = eval 'fagwoosh';
- is ($@, '');
- is_deeply (\@value, [5]);
-
- eval 'use constant putt => 6, 7; 1' or die $@;
-
- is ("@warnings", "", "No warnings if the typeglob exists already");
-
- @value = eval 'putt';
- is ($@, '');
- is_deeply (\@value, [6, 7]);
-
- eval 'use constant "klong"; 1' or die $@;
-
- is ("@warnings", "", "No warnings if the typeglob exists already");
-
- $value = eval 'klong';
- is ($@, '');
- is ($value, undef);
-
- @value = eval 'klong';
- is ($@, '');
- is_deeply (\@value, []);
-}