From: Peter Rabbitson <ribasushi@cpan.org>
Date: Fri, 22 Apr 2011 10:32:56 +0000 (+0200)
Subject: Bring back 5.8.1 support
X-Git-Tag: release_0.009008~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2215d4b9bdc64e7994b2a90d50cc2ab906115d0f;p=gitmo%2FRole-Tiny.git

Bring back 5.8.1 support

- 5.8.1 randomizes hash keys - need to sort when comparing
- < 5.8.3 can not weaken refs to r/o vars, die with more info
  (the extra code is compiled away on >= 5.8.3)
- Spurious warnings from indirect.pm (RT#67692) trip up strictures'
  dfatalized warnings
---

diff --git a/Changes b/Changes
index 4d3449e..8a0ca07 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,5 @@
+  - Bring back 5.8.1 compat
+
 0.009007 - 2011-02-25
   - I botched the copyright. re-disting.
 
diff --git a/Makefile.PL b/Makefile.PL
index e53578d..93dcb4f 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,6 +1,6 @@
 use strict;
 use warnings FATAL => 'all';
-use 5.008003;
+use 5.008001;
 use ExtUtils::MakeMaker;
 (do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml';
 
diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index 76e2a54..c8c6b49 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -336,9 +336,33 @@ sub _generate_simple_set {
   my ($self, $me, $name, $spec, $value) = @_;
   my $name_str = perlstring $name;
   my $simple = "${me}->{${name_str}} = ${value}";
+
   if ($spec->{weak_ref}) {
     require Scalar::Util;
-    "Scalar::Util::weaken(${simple})";
+
+    # Perl < 5.8.3 can't weaken refs to readonly vars
+    # (e.g. string constants). This *can* be solved by:
+    #
+    #Internals::SetReadWrite($foo);
+    #Scalar::Util::weaken ($foo);
+    #Internals::SetReadOnly($foo);
+    #
+    # but requires XS and is just too damn crazy
+    # so simply throw a better exception
+    Moo::_Utils::lt_5_8_3() ? <<"EOC" : "Scalar::Util::weaken(${simple})";
+
+      eval { Scalar::Util::weaken($simple); 1 } or do {
+        if( \$@ =~ /Modification of a read-only value attempted/) {
+          require Carp;
+          Carp::croak( sprintf (
+            'Reference to readonly value in "%s" can not be weakened on Perl < 5.8.3',
+            $name_str,
+          ) );
+        } else {
+          die \$@;
+        }
+      };
+EOC
   } else {
     $simple;
   }
diff --git a/lib/Moo/_Utils.pm b/lib/Moo/_Utils.pm
index aaa903a..d332ec6 100644
--- a/lib/Moo/_Utils.pm
+++ b/lib/Moo/_Utils.pm
@@ -3,6 +3,13 @@ package Moo::_Utils;
 sub _getglob { \*{$_[0]} }
 sub _getstash { \%{"$_[0]::"} }
 
+BEGIN {
+  *lt_5_8_3 = $] < 5.008003
+    ? sub () { 1 }
+    : sub () { 0 }
+  ;
+}
+
 use strictures 1;
 use base qw(Exporter);
 
diff --git a/t/accessor-weaken.t b/t/accessor-weaken.t
index 2bfecbe..3b99264 100644
--- a/t/accessor-weaken.t
+++ b/t/accessor-weaken.t
@@ -9,11 +9,29 @@ use Test::More;
   has one => (is => 'ro', weak_ref => 1);
 }
 
-my $ref = \'yay';
-
+my $ref = {};
 my $foo = Foo->new(one => $ref);
-
-is(${$foo->one},'yay', 'value present');
+is($foo->one, $ref, 'value present');
 ok(Scalar::Util::isweak($foo->{one}), 'value weakened');
+undef $ref;
+ok (!defined $foo->{one}, 'weak value gone');
+
+# test readonly SVs
+sub mk_ref { \ 'yay' };
+my $foo_ro = eval { Foo->new(one => mk_ref()) };
+if ($] < 5.008003) {
+  like(
+    $@,
+    qr/\QReference to readonly value in "one" can not be weakened on Perl < 5.8.3/,
+    'Expected exception thrown on old perls'
+  );
+}
+else {
+  is(${$foo_ro->one},'yay', 'value present');
+  ok(Scalar::Util::isweak($foo_ro->{one}), 'value weakened');
+
+  { no warnings 'redefine'; *mk_ref = sub {} }
+  ok (!defined $foo_ro->{one}, 'optree reaped, ro static value gone');
+}
 
 done_testing;
diff --git a/t/load_module.t b/t/load_module.t
index 290f071..6841e93 100644
--- a/t/load_module.t
+++ b/t/load_module.t
@@ -1,6 +1,8 @@
+# work around RT#67692
+use Moo::_Utils;
 use strictures 1;
+
 use Test::More;
-use Moo::_Utils;
 
 local @INC = (sub {
   return unless $_[1] eq 'Foo/Bar.pm';
diff --git a/t/sub-quote.t b/t/sub-quote.t
index c610766..1f86fa5 100644
--- a/t/sub-quote.t
+++ b/t/sub-quote.t
@@ -21,7 +21,7 @@ ok(!keys %EVALED, 'Nothing evaled yet');
 my $u_one = unquote_sub $one;
 
 is_deeply(
-  [ keys %EVALED ], [ qw(one two) ],
+  [ sort keys %EVALED ], [ qw(one two) ],
   'Both subs evaled'
 );