From: Dave Rolsky <autarch@urth.org>
Date: Sun, 13 Sep 2009 15:38:08 +0000 (-0500)
Subject: Add tests for warning on $object->new and implement immutable version of warning.
X-Git-Tag: 0.90~31
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=62c8675ec025457cc82e7d774d9f9edeb6721e83;p=gitmo%2FMoose.git

Add tests for warning on $object->new and implement immutable version of warning.
---

diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm
index 4d4a580..e25ae44 100644
--- a/lib/Moose/Meta/Method/Constructor.pm
+++ b/lib/Moose/Meta/Method/Constructor.pm
@@ -56,6 +56,10 @@ sub _initialize_body {
     # the author, after all, nothing is free)
     my $source = 'sub {';
     $source .= "\n" . 'my $_instance = shift;';
+
+    $source .= "\n" . q{Carp::cluck 'Calling new() on an instance is deprecated,'
+                        . ' please use (blessed $obj)->new' if blessed $_instance;};
+
     $source .= "\n" . 'my $class = Scalar::Util::blessed($_instance) || $_instance;';
 
     $source .= "\n" . 'return $class->Moose::Object::new(@_)';
diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm
index 940bb6f..7702611 100644
--- a/lib/Moose/Object.pm
+++ b/lib/Moose/Object.pm
@@ -18,14 +18,12 @@ our $AUTHORITY = 'cpan:STEVAN';
 
 sub new {
     my $class = shift;
-    
+
     Carp::cluck 'Calling new() on an instance is deprecated,'
       . ' please use (blessed $obj)->new' if blessed $class;
-    
+
     my $params = $class->BUILDARGS(@_);
 
-    # We want to support passing $self->new, but initialize
-    # takes only an unblessed class name
     my $real_class = Scalar::Util::blessed($class) || $class;
     my $self = Class::MOP::Class->initialize($real_class)->new_object($params);
 
diff --git a/t/010_basics/021-instance-new.t b/t/010_basics/021-instance-new.t
new file mode 100644
index 0000000..3555730
--- /dev/null
+++ b/t/010_basics/021-instance-new.t
@@ -0,0 +1,25 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+BEGIN {
+    eval "use Test::Output;";
+    plan skip_all => "Test::Output is required for this test" if $@;
+    plan tests => 2;
+}
+
+{
+    package Foo;
+    use Moose;
+}
+
+{
+    my $foo = Foo->new();
+    stderr_like { $foo->new() }
+    qr/\QCalling new() on an instance is deprecated/,
+        '$object->new() is deprecated';
+
+    Foo->meta->make_immutable, redo
+        if Foo->meta->is_mutable;
+}