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.

diff --git a/pp_sort.c b/pp_sort.c
index 56c0aac..a67ad4e 100644 (file)
--- 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 d2ae04a..3ac3990 100644 (file)
--- 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 a9ef542..235212f 100644 (file)
--- 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 ca749a0..452a66b 100644 (file)
--- 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';
 }
 
 {