develooper Front page | perl.perl5.porters | Postings from April 2003

[PATCH] make assignments to %:: a compile-time error

Thread Next
From:
Dave Mitchell
Date:
April 20, 2003 18:29
Subject:
[PATCH] make assignments to %:: a compile-time error
Message ID:
20030421012944.GE16762@fdgroup.com
The bugs database is littered with variants of
    "I am shocked! %main:: = () causes a coredump".
Of course the correct response is "well, don't do that, then", but
since people seem to do it regardless, here is a patch that
makes assignment to %:: a compile-time error. Of course this won't catch
all possible variants on that particular theme of stupidity
(delete $::{$_} for keys %::, anyone?), but at least it does catch what I
perceive as being the most common offender.

Dave.

-- 
Lady Nancy Astor: If you were my husband, I would flavour your coffee
with poison.
Churchill: Madam - if I were your husband, I would drink it.


# This is a patch for 19282.ORIG to update it to 19282
# 
# To apply this patch:
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'applypatch' program with this patch file as input.
#
# If you do not have 'applypatch', it is part of the 'makepatch' package
# that you can fetch from the Comprehensive Perl Archive Network:
# http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz
# In the above URL, 'x' should be 2 or higher.
#
# To apply this patch without the use of 'applypatch':
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'patch' program with this file as input.
#
#### End of Preamble ####

#### Patch data follows ####
diff -up '19282.ORIG/op.c' '19282/op.c'
Index: ./op.c
--- ./op.c	Mon Apr 21 00:05:41 2003
+++ ./op.c	Mon Apr 21 01:36:14 2003
@@ -3037,6 +3037,14 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *le
 {
     OP *o;
 
+    /* discourage %:: = () */
+    if (left->op_type == OP_RV2HV &&
+	    cUNOPx(left)->op_first->op_type == OP_GV &&
+	    GvHV((GV*)cGVOPx_gv((cUNOPx(left)->op_first))) == PL_defstash)
+    {
+	Perl_croak(aTHX_ "Can't assign to %::");
+    }
+
     if (optype) {
 	if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN || optype == OP_DORASSIGN) {
 	    return newLOGOP(optype, 0,
diff -up '19282.ORIG/pod/perldiag.pod' '19282/pod/perldiag.pod'
Index: ./pod/perldiag.pod
--- ./pod/perldiag.pod	Mon Apr 21 00:05:58 2003
+++ ./pod/perldiag.pod	Mon Apr 21 01:11:25 2003
@@ -484,6 +484,11 @@ See L<perlfunc/pack>.
 (F) An argument to pack("w",...) was negative.  The BER compressed integer
 format can only be used with positive integers.  See L<perlfunc/pack>.
 
+=item Can't assign to %::
+
+(F) Deleting the main symbol table isn't very wise, and Perl will try to
+stop you. eg C<%:: = ()>.
+
 =item Can't bless non-reference value
 
 (F) Only hard references may be blessed.  This is how Perl "enforces"
diff -up '19282.ORIG/t/op/stash.t' '19282/t/op/stash.t'
Index: ./t/op/stash.t
--- ./t/op/stash.t	Mon Apr 21 00:06:04 2003
+++ ./t/op/stash.t	Mon Apr 21 01:11:23 2003
@@ -7,12 +7,18 @@ BEGIN {
 
 require "./test.pl";
 
-plan( tests => 1 );
+plan( tests => 2 );
 
 # Used to segfault (bug #15479)
 fresh_perl_is(
-    '%:: = ""',
+    'delete $::{STDERR}; my %a = ""',
     'Odd number of elements in hash assignment at - line 1.',
     { switches => [ '-w' ] },
     'delete $::{STDERR} and print a warning',
 );
+
+# this should be a compile-time error
+
+eval '%:: = ()';
+like($@, qr/Can't assign to %::/, '%:: = ()');
+
#### End of Patch data ####

#### ApplyPatch data follows ####
# Data version        : 1.0
# Date generated      : Mon Apr 21 01:46:47 2003
# Generated by        : makepatch 2.00_05
# Recurse directories : Yes
# Excluded files      : keywords\.h|warnings\.h|regnodes\.h|perlapi\.c|perlapi\.h|global\.sym|embedvar\.h|embed\.h|pod\/perlapi\.pod|pod\/perlintern\.pod|proto\.h
# v 'patchlevel.h' 4640 1050879998 33188
# p 'op.c' 158770 1050885374 0100644
# p 'pod/perldiag.pod' 161271 1050883885 0100644
# p 't/op/stash.t' 316 1050883883 0100644
#### End of ApplyPatch data ####

#### End of Patch kit [created: Mon Apr 21 01:46:47 2003] ####
#### Patch checksum: 76 2503 52834 ####
#### Checksum: 94 3179 42920 ####

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