Let people clear the default value of an attribute when inheriting

lib/Moose/Exception/BothAttributeAndClearAttributeAreNotAllowed.pm

@@ -0,0 +1,21 @@
+package Moose::Exception::BothAttributeAndClearAttributeAreNotAllowed;
+our $VERSION = '2.2013';
+
+use Moose;
+extends 'Moose::Exception';
+with 'Moose::Exception::Role::ParamsHash';
+
+has 'attribute_name' => (
+    is       => 'ro',
+    isa      => 'Str',
+    required => 1
+);
+
+sub _build_message {
+    my $self = shift;
+    return "You said both to clear_" . $self->attribute_name
+        . " and also to set a value for " . $self->attribute_name;
+}
+
+__PACKAGE__->meta->make_immutable;
+1;

lib/Moose/Exception/InvalidClearedAttribute.pm

@@ -0,0 +1,21 @@
+package Moose::Exception::InvalidClearedAttribute;
+our $VERSION = '2.2013';
+
+use Moose;
+extends 'Moose::Exception';
+with 'Moose::Exception::Role::ParamsHash';
+
+has 'attribute_name' => (
+    is       => 'ro',
+    isa      => 'Str',
+    required => 1,
+);
+
+sub _build_message {
+    my $self = shift;
+    "You said clear_" . $self->attribute_name . " but " . $self->attribute_name
+        . " is not the name of an existing attribute";
+}
+
+__PACKAGE__->meta->make_immutable;
+1;

lib/Moose/Manual/Attributes.pod

@@ -575,6 +575,35 @@ As a consequence, any method modifiers defined on the attribute's accessors in
 an ancestor class will effectively be ignored, because the new accessors live
 in the child class and do not see the modifiers from the parent class.
 
+=head2 Clearing Aspects
+
+Sometimes, you may decide that you don't want to override an aspect of the
+original attribute with a new value; rather, you want there to be I<no value>.
+(For instance, the default would normally have been a value that is no longer
+valid; but undef or the empty string aren't valid either.) In situations like
+this, prepend the attribute name with C<clear_>: e.g.
+
+ person Person::Archaic;
+
+ use Moose;
+
+ has 'gender' => (
+     is      => 'ro',
+     isa     => 'Gender',
+     default => 'Male',
+ );
+
+ package Person::Modern;
+
+ use Moose;
+ extends 'Person::Archaic';
+
+ has '+gender' => (
+     is            => 'rw',
+     clear_default => 1,
+     required      => 1,
+ );
+
 =head1 MULTIPLE ATTRIBUTE SHORTCUTS
 
 If you have a number of attributes that differ only by name, you can declare

lib/Moose/Meta/Attribute.pm

@@ -238,13 +238,37 @@ sub clone {
 
     my $class = delete $params{metaclass} || ref $self;
 
-    my ( @init, @non_init );
-
-    foreach my $attr ( grep { $_->has_value($self) } Class::MOP::class_of($self)->get_all_attributes ) {
-        push @{ $attr->has_init_arg ? \@init : \@non_init }, $attr;
+    my ( %new_params, @non_init );
+
+    my @possible_attrs = Class::MOP::class_of($self)->get_all_attributes;
+    my %attr_by_name = map { $_->name => $_ } @possible_attrs;
+    foreach my $attr ( grep { $_->has_value($self) } @possible_attrs ) {
+        if ($attr->has_init_arg) {
+            $new_params{$attr->init_arg} = $attr->get_value($self);
+        } else {
+            push @non_init, $attr;
+        }
     }
 
-    my %new_params = ( ( map { $_->init_arg => $_->get_value($self) } @init ), %params );
+    for my $param_name (keys %params) {
+        if ($param_name =~ /^ clear_ (.+) /x) {
+            my $cleared_attr_name = $1;
+            if ($attr_by_name{$cleared_attr_name}) {
+                if (exists $params{$cleared_attr_name}) {
+                    throw_exception( BothAttributeAndClearAttributeAreNotAllowed => attribute_name => $cleared_attr_name,
+                                                                                    params => \%params
+                                   );
+                }
+                delete $new_params{$cleared_attr_name};
+            } else {
+                throw_exception( InvalidClearedAttribute => attribute_name => $cleared_attr_name,
+                                                            params         => \%params
+                               );
+            }
+        } else {
+            $new_params{$param_name} = $params{$param_name};
+        }
+    }
 
     my $name = delete $new_params{name};
 

t/attributes/attribute_inherited_slot_specs.t

@@ -114,6 +114,32 @@ use Test::Fatal;
     ::like( ::exception {
         has '+does_not_exist' => (isa => 'Str');
     }, qr/in Bar/, '... cannot extend a non-existing attribute' );
+
+    ::is( ::exception {
+        has '+baz' => (clear_default => 1),
+    }, undef, 'Can trivially clear an already-cleared attribute');
+
+    package Foo::VagueBar;
+    use Moose;
+
+    extends 'Foo';
+
+    ::like( ::exception {
+        has '+bar' => (clear_brush => 'I live in Texas, I just do this');
+    }, qr/You said clear_brush but/, 'Cannot clear a non-existent attribute');
+    my $re_make_up_your_mind
+        = qr/You said both to clear_default and also to set a value for default/;
+    ::like( ::exception {
+        has '+bar' => (clear_default => 1, default => 'Something reasonable');
+    }, $re_make_up_your_mind,
+       'Must be consistent: default value or no default value?');
+   ::like( ::exception {
+       has '+bar' => (clear_default => 1, default => 0);
+   }, $re_make_up_your_mind,
+      '...including when the new default value is false');
+    ::is( ::exception {
+        has '+bar' => (clear_default => 1);
+    }, undef, 'Can clear a previous default');
 }
 
 my $foo = Foo->new;
@@ -191,6 +217,12 @@ is($bar->baz, undef, '... got the right undef default value');
     isnt( exception { $bar->baz($code_ref) }, undef, '... Bar::baz does not accept a code ref' );
 }
 
+my $foo_vaguebar = Foo::VagueBar->new;
+isa_ok($foo_vaguebar, 'Foo::VagueBar');
+isa_ok($foo_vaguebar, 'Foo');
+ok(!$foo_vaguebar->meta->find_attribute_by_name('bar')->has_value($foo_vaguebar),
+    'An attribute whose definition gets rid of a default value does not have a value');
+
 # check some meta-stuff
 
 ok(Bar->meta->has_attribute('foo'), '... Bar has a foo attr');