Handle defaults with quote-breaking values correctly by using

quotemeta. Added tests for this.

diff --git a/Changes b/Changes
index b2664f6..311cddc 100644 (file)
--- a/Changes
+++ b/Changes
@@ -14,6 +14,9 @@ Revision history for Perl extension Moose
         inlining anyway, pass "replace_constructor => 1" to
         make_immutable. Addresses RT #40968, reported by Jon
         Swartz. (Dave Rolsky)
+      - The quoting of default values could be broken if the default
+        contained a single quote ('). Now we use quotemeta to escape
+        anything potentially dangerous in the defaults. (Dave Rolsky)
 
 0.62_01 Wed, December 3, 2008
     * Moose::Object

diff --git a/MANIFEST b/MANIFEST
index f3ead5e..26b8e62 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -254,6 +254,7 @@ t/300_immutable/008_immutable_constructor_error.t
 t/300_immutable/009_buildargs.t
 t/300_immutable/010_constructor_is_not_moose.t
 t/300_immutable/011_constructor_is_wrapped.t
+t/300_immutable/012_default_values.t
 t/400_moose_util/001_moose_util.t
 t/400_moose_util/002_moose_util_does_role.t
 t/400_moose_util/003_moose_util_search_class_by_role.t

diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm
index 644ed93..655a9b8 100644 (file)
--- a/lib/Moose/Meta/Method/Constructor.pm
+++ b/lib/Moose/Meta/Method/Constructor.pm
@@ -392,10 +392,7 @@ sub _generate_default_value {
         return '$attrs->[' . $index . ']->default($instance)';
     }
     else {
-        my $default = $attr->default;
-        # make sure to quote strings ...
-        return "'$default'";
-        
+        return q{"} . quotemeta( $attr->default ) . q{"};
     }
 }
 

diff --git a/t/300_immutable/012_default_values.t b/t/300_immutable/012_default_values.t
new file mode 100644 (file)
index 0000000..f74a694
--- /dev/null
+++ b/t/300_immutable/012_default_values.t
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+use Test::Exception;
+
+{
+
+    package Foo;
+    use Moose;
+
+    has 'foo' => ( is => 'rw', default => q{'} );
+    has 'bar' => ( is => 'rw', default => q{\\} );
+    has 'baz' => ( is => 'rw', default => q{"} );
+    has 'buz' => ( is => 'rw', default => q{"'\\} );
+    has 'faz' => ( is => 'rw', default => qq{\0} );
+
+    ::lives_ok {  __PACKAGE__->meta->make_immutable }
+        'no errors making a package immutable when it has default values that could break quoting';
+}
+
+my $foo = Foo->new;
+is( $foo->foo, q{'},
+    'default value for foo attr' );
+is( $foo->bar, q{\\},
+    'default value for bar attr' );
+is( $foo->baz, q{"},
+    'default value for baz attr' );
+is( $foo->buz, q{"'\\},
+    'default value for buz attr' );
+is( $foo->faz, qq{\0},
+    'default value for faz attr' );
+
+
+# Lazy attrs were never broken, but it doesn't hurt to test that they
+# won't be broken by any future changes.
+{
+
+    package Bar;
+    use Moose;
+
+    has 'foo' => ( is => 'rw', default => q{'}, lazy => 1 );
+    has 'bar' => ( is => 'rw', default => q{\\}, lazy => 1 );
+    has 'baz' => ( is => 'rw', default => q{"}, lazy => 1 );
+    has 'buz' => ( is => 'rw', default => q{"'\\}, lazy => 1 );
+    has 'faz' => ( is => 'rw', default => qq{\0}, lazy => 1 );
+
+    ::lives_ok {  __PACKAGE__->meta->make_immutable }
+        'no errors making a package immutable when it has lazy default values that could break quoting';
+}
+
+my $bar = Bar->new;
+is( $bar->foo, q{'},
+    'default value for foo attr' );
+is( $bar->bar, q{\\},
+    'default value for bar attr' );
+is( $bar->baz, q{"},
+    'default value for baz attr' );
+is( $bar->buz, q{"'\\},
+    'default value for buz attr' );
+is( $bar->faz, qq{\0},
+    'default value for faz attr' );