develooper Front page | perl.perl5.porters | Postings from May 2001

[PATCH] vars.pm to support qualified variables (was Re: [ID 20010521.001])

Thread Next
From:
Mike Guy
Date:
May 22, 2001 05:11
Subject:
[PATCH] vars.pm to support qualified variables (was Re: [ID 20010521.001])
Message ID:
E152B0l-0006mb-00@virgo.cus.cam.ac.uk
Michael Stevens <mstevens@globnix.org> wrote
> Line 42 in my copy is:
> 
> use vars qw($OS2::is_aout);

It has long been a pet hate of mine that one has to write circumlocutions
like

	{ package DB; use vars '$single' };

in order to avoid "used once" warnings.   And the restriction in vars.pm
is entirely undocumented.

So here's a patch (for bleadperl) to vars.pm to support qualified variables.
And also a test suite for vars.pm since there wasn't one.

And before people start shouting "But 'use vars' is obsolete", note that
this case is not supported by "our", and Larry has decreed that it never
will be.


Mike Guy

--- ./t/pragma/vars.t.orig	Mon May 21 13:46:24 2001
+++ ./t/pragma/vars.t	Tue May 22 12:23:39 2001
@@ -0,0 +1,105 @@
+#!./perl 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    $ENV{PERL5LIB} = '../lib';
+}
+
+$| = 1;
+
+print "1..27\n";
+
+# catch "used once" warnings
+my @warns;
+BEGIN { $SIG{__WARN__} = sub { push @warns, @_ }; $^W = 1 };
+
+%x = ();
+$y = 3;
+@z = ();
+$X::x = 13;
+
+use vars qw($p @q %r *s &t $X::p);
+
+my $e = !(grep /^Name "X::x" used only once: possible typo/, @warns) && 'not ';
+print "${e}ok 1\n";
+$e = !(grep /^Name "main::x" used only once: possible typo/, @warns) && 'not ';
+print "${e}ok 2\n";
+$e = !(grep /^Name "main::y" used only once: possible typo/, @warns) && 'not ';
+print "${e}ok 3\n";
+$e = !(grep /^Name "main::z" used only once: possible typo/, @warns) && 'not ';
+print "${e}ok 4\n";
+($e, @warns) = @warns != 4 && 'not ';
+print "${e}ok 5\n";
+
+# this is inside eval() to avoid creation of symbol table entries and
+# to avoid "used once" warnings
+eval <<'EOE';
+$e = ! $main::{p} && 'not ';
+print "${e}ok 6\n";
+$e = ! *q{ARRAY} && 'not ';
+print "${e}ok 7\n";
+$e = ! *r{HASH} && 'not ';
+print "${e}ok 8\n";
+$e = ! $main::{s} && 'not ';
+print "${e}ok 9\n";
+$e = ! *t{CODE} && 'not ';
+print "${e}ok 10\n";
+$e = defined $X::{q} && 'not ';
+print "${e}ok 11\n";
+$e = ! $X::{p} && 'not ';
+print "${e}ok 12\n";
+EOE
+$e = $@ && 'not ';
+print "${e}ok 13\n";
+
+eval q{use vars qw(@X::y !abc); $e = ! *X::y{ARRAY} && 'not '};
+print "${e}ok 14\n";
+$e = $@ !~ /^'!abc' is not a valid variable name/ && 'not ';
+print "${e}ok 15\n";
+
+eval 'use vars qw($x[3])';
+$e = $@ !~ /^Can't declare individual elements of hash or array/ && 'not ';
+print "${e}ok 16\n";
+
+{ local $^W;
+  eval 'use vars qw($!)';
+  ($e, @warns) = ($@ || @warns) ? 'not ' : '';
+  print "${e}ok 17\n";
+};
+
+# NB the next test only works because vars.pm has already been loaded
+eval 'use warnings "vars"; use vars qw($!)';
+$e = ($@ || (shift(@warns)||'') !~ /^No need to declare built-in vars/)
+			&& 'not ';
+print "${e}ok 18\n";
+
+no strict 'vars';
+eval 'use vars qw(@x%%)';
+$e = $@ && 'not ';
+print "${e}ok 19\n";
+$e = ! *{'x%%'}{ARRAY} && 'not ';
+print "${e}ok 20\n";
+eval '$u = 3; @v = (); %w = ()';
+$e = $@ && 'not ';
+print "${e}ok 21\n";
+
+use strict 'vars';
+eval 'use vars qw(@y%%)';
+$e = $@ !~ /^'\@y%%' is not a valid variable name under strict vars/ && 'not ';
+print "${e}ok 22\n";
+$e = *{'y%%'}{ARRAY} && 'not ';
+print "${e}ok 23\n";
+eval '$u = 3; @v = (); %w = ()';
+my @errs = split /\n/, $@;
+$e = @errs != 3 && 'not ';
+print "${e}ok 24\n";
+$e = !(grep(/^Global symbol "\$u" requires explicit package name/, @errs))
+			&& 'not ';
+print "${e}ok 25\n";
+$e = !(grep(/^Global symbol "\@v" requires explicit package name/, @errs))
+			&& 'not ';
+print "${e}ok 26\n";
+$e = !(grep(/^Global symbol "\%w" requires explicit package name/, @errs))
+			&& 'not ';
+print "${e}ok 27\n";
--- ./t/lib/1_compile.t.orig	Wed May 16 22:02:07 2001
+++ ./t/lib/1_compile.t	Mon May 21 14:34:43 2001
@@ -241,6 +241,5 @@
 strict
 subs
 utf8
-vars
 warnings
 warnings::register
--- ./lib/vars.pm.orig	Wed Dec  6 15:10:18 2000
+++ ./lib/vars.pm	Tue May 22 11:42:37 2001
@@ -17,31 +17,29 @@
 sub import {
     my $callpack = caller;
     my ($pack, @imports, $sym, $ch) = @_;
-    foreach $sym (@imports) {
-        ($ch, $sym) = unpack('a1a*', $sym);
+    foreach (@imports) {
+        ($ch, $sym) = unpack('a1a*', $_);
 	if ($sym =~ tr/A-Za-z_0-9//c) {
 	    # time for a more-detailed check-up
-	    if ($sym =~ /::/) {
-		require Carp;
-		Carp::croak("Can't declare another package's variables");
-	    } elsif ($sym =~ /^\w+[[{].*[]}]$/) {
+	    if ($sym =~ /^\w+[[{].*[]}]$/) {
 		require Carp;
 		Carp::croak("Can't declare individual elements of hash or array");
 	    } elsif (warnings::enabled() and length($sym) == 1 and $sym !~ tr/a-zA-Z//) {
 		warnings::warn("No need to declare built-in vars");
             } elsif  ( $^H &= strict::bits('vars') ) {
-              Carp::croak("'$ch$sym' is not a valid variable name under strict vars");
+              Carp::croak("'$_' is not a valid variable name under strict vars");
 	    }
 	}
-        *{"${callpack}::$sym"} =
-          (  $ch eq "\$" ? \$   {"${callpack}::$sym"}
-           : $ch eq "\@" ? \@   {"${callpack}::$sym"}
-           : $ch eq "\%" ? \%   {"${callpack}::$sym"}
-           : $ch eq "\*" ? \*   {"${callpack}::$sym"}
-           : $ch eq "\&" ? \&   {"${callpack}::$sym"}
+	$sym = "${callpack}::$sym" unless $sym =~ /::/;
+        *$sym =
+          (  $ch eq "\$" ? \$$sym
+           : $ch eq "\@" ? \@$sym
+           : $ch eq "\%" ? \%$sym
+           : $ch eq "\*" ? \*$sym
+           : $ch eq "\&" ? \&$sym
            : do {
 		require Carp;
-		Carp::croak("'$ch$sym' is not a valid variable name");
+		Carp::croak("'$_' is not a valid variable name");
 	     });
     }
 };
@@ -59,9 +57,9 @@
 
 =head1 DESCRIPTION
 
-NOTE: The functionality provided by this pragma has been superseded
-by C<our> declarations, available in Perl v5.6.0 or later.  See
-L<perlfunc/our>.
+NOTE: For variables in the current package, the functionality provided
+by this pragma has been superseded by C<our> declarations, available
+in Perl v5.6.0 or later.  See L<perlfunc/our>.
 
 This will predeclare all the variables whose names are 
 in the list, allowing you to use them under "use strict", and

End of patch

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About