This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
remove assertion that collation magic has data
authorTony Cook <tony@develop-help.com>
Thu, 29 Oct 2020 04:59:16 +0000 (15:59 +1100)
committerTony Cook <tony@develop-help.com>
Thu, 29 Oct 2020 04:59:16 +0000 (15:59 +1100)
This broke on some smokers where the locale collation data was
broken in some way (and rejected by the collation setup code.)

It also broke if collation magic was generated for an SV and then
the SV was modified, freeing the collation data before the SV was
destroyed.

mg.c
t/run/locale.t

diff --git a/mg.c b/mg.c
index d14b2eb..32d7732 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2669,9 +2669,12 @@ Perl_magic_freecollxfrm(pTHX_ SV *sv, MAGIC *mg)
     /* Collate magic uses mg_len as a string length rather than a buffer
      * length, so we need to free even with mg_len == 0: hence we can't
      * rely on standard magic free handling */
-    assert(mg->mg_type == PERL_MAGIC_collxfrm && mg->mg_len >= 0);
-    Safefree(mg->mg_ptr);
-    mg->mg_ptr = NULL;
+    if (mg->mg_len >= 0) {
+        assert(mg->mg_type == PERL_MAGIC_collxfrm);
+        Safefree(mg->mg_ptr);
+        mg->mg_ptr = NULL;
+    }
+
     return 0;
 }
 #endif /* USE_LOCALE_COLLATE */
index 78cfc2f..e072b63 100644 (file)
@@ -510,4 +510,29 @@ EOF
 
 }
 
+SKIP:
+{
+    use locale;
+    # look for an english locale (so a < B, hopefully)
+    my ($en) = grep /^en_/, @locales;
+    POSIX::setlocale(LC_COLLATE, $en);
+    unless ("a" lt "B") {
+        skip "didn't find a suitable locale", 1;
+    }
+    fresh_perl_is(<<'EOF', "ok\n", { args => [ $en ] }, "check for failed assertion");
+use locale ':collate';
+use POSIX qw(setlocale LC_COLLATE);
+if (setlocale(LC_COLLATE, shift)) {
+     my $x = "a";
+     my $y = "B";
+     print $x lt $y ? "ok\n" : "not ok\n";
+     $x = "c"; # should empty the collxfrm magic but not remove it
+     # which the free code asserts on
+}
+else {
+     print "ok\n";
+}
+EOF
+}
+
 done_testing();