In-place sort should not leave array read-only

$ ./perl -Ilib -e '@a=1..2; eval { @a=sort{die} @a }; warn "ok so far\n"; @a = 1'
ok so far
Modification of a read-only value attempted at -e line 1.

If something goes wrong inside the sort block and it dies, we still
need to make sure we turn off the read-only flag on that array.

4 files changed, 14 insertions, 5 deletions

diff --git a/pp_sort.c b/pp_sort.c
index 56c0aac5db..a67ad4e335 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1588,7 +1588,10 @@ PP(pp_sort)
 	    if (SvREADONLY(av))
 		Perl_croak_no_modify();
 	    else
+	    {
 		SvREADONLY_on(av);
+		save_pushptr((void *)av, SAVEt_READONLY_OFF);
+	    }
 	    p1 = p2 = AvARRAY(av);
 	    sorting_av = 1;
 	}
diff --git a/scope.c b/scope.c
index d2ae04a650..3ac3990fff 100644
--- a/scope.c
+++ b/scope.c
@@ -1228,6 +1228,9 @@ Perl_leave_scope(pTHX_ I32 base)
 	case SAVEt_PARSER:
 	    parser_free((yy_parser *) ARG0_PTR);
 	    break;
+	case SAVEt_READONLY_OFF:
+	    SvREADONLY_off(ARG0_SV);
+	    break;
 	default:
 	    Perl_croak(aTHX_ "panic: leave_scope inconsistency %u", type);
 	}
diff --git a/scope.h b/scope.h
index a9ef5426f7..235212f9e3 100644
--- a/scope.h
+++ b/scope.h
@@ -38,12 +38,12 @@
 #define SAVEt_OP		18
 #define SAVEt_PARSER		19
 #define SAVEt_STACK_POS		20
+#define SAVEt_READONLY_OFF	21
 
-#define SAVEt_ARG1_MAX		20
+#define SAVEt_ARG1_MAX		21
 
 /* two args */
 
-#define SAVEt_ADELETE		21
 #define SAVEt_APTR		22
 #define SAVEt_AV		23
 #define SAVEt_DESTRUCTOR	24
@@ -68,17 +68,18 @@
 #define SAVEt_SV		43
 #define SAVEt_SVREF		44
 #define SAVEt_VPTR		45
+#define SAVEt_ADELETE		46
 
-#define SAVEt_ARG2_MAX		45
+#define SAVEt_ARG2_MAX		46
 
 /* three args */
 
-#define SAVEt_AELEM		46
 #define SAVEt_DELETE		47
 #define SAVEt_HELEM		48
 #define SAVEt_PADSV_AND_MORTALIZE 49
 #define SAVEt_SET_SVFLAGS	50
 #define SAVEt_GVSLOT		51
+#define SAVEt_AELEM		52
 
 #define SAVEf_SETMAGIC		1
 #define SAVEf_KEEPOLDELEM	2
diff --git a/t/op/sort.t b/t/op/sort.t
index ca749a063b..452a66baf7 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -6,7 +6,7 @@ BEGIN {
     require 'test.pl';
 }
 use warnings;
-plan( tests => 177 );
+plan( tests => 178 );
 
 # these shouldn't hang
 {
@@ -770,6 +770,8 @@ cmp_ok($answer,'eq','good','sort subr called from other package');
 
     $fail_msg = q(Modification of a read-only value attempted);
     cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'bug 7567');
+    eval { @a=1..3 };
+    is $@, "", 'abrupt scope exit turns off readonliness';
 }
 
 {