Move constant from ext/ to dist/

2 files changed, 735 insertions, 0 deletions

diff --git a/dist/constant/lib/constant.pm b/dist/constant/lib/constant.pm
new file mode 100644
index 0000000000..a51ee7f277
--- /dev/null
+++ b/dist/constant/lib/constant.pm
@@ -0,0 +1,392 @@
+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/dist/constant/t/constant.t b/dist/constant/t/constant.t
new file mode 100644
index 0000000000..a42b7d2281
--- /dev/null
+++ b/dist/constant/t/constant.t
@@ -0,0 +1,343 @@
+#!./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, []);
+}