Avoid crashes when casifying noncontiguous regions

This is a followon fix for Bug#37477.
* lisp/simple.el (region-extract-function):
Use setq here, since the var is now defined in C code.
* src/casefiddle.c (casify_pnc_region): New function.
(Fupcase_region, Fdowncase_region, Fcapitalize_region)
(Fupcase_initials_region): Use it.
(Fupcase_initials_region): Add region-noncontiguous-p flag
for consistency with the others.  All uses changed.
(syms_of_casefiddle): Define Qbounds, Vregion_extract_function.
* src/insdel.c (prepare_to_modify_buffer_1):
* src/keyboard.c (command_loop_1):
Use Vregion_extraction_function.
* src/insdel.c (syms_of_insdel): No need to define
Qregion_extract_function.
* test/src/casefiddle-tests.el (casefiddle-oldfunc): New var.
(casefiddle-loopfunc, casefiddle-badfunc): New functions.
(casefiddle-invalid-region-extract-function): New test.

diff --git a/etc/NEWS b/etc/NEWS
index 8a880e5b63a3ea23a01b397650b7b60d5a22e351..73f0ca2497b1b2362c67ab241923b11b4bc2b949 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -488,7 +488,8 @@ interface that's more like functions like 'search-forward'.
 ---
 ** More commands support noncontiguous rectangular regions, namely
 'upcase-dwim', 'downcase-dwim', 'capitalize-dwim', 'capitalize-region',
-'replace-string', 'replace-regexp', and 'delimit-columns-region'.
+'upcase-initials-region', 'replace-string', 'replace-regexp', and
+'delimit-columns-region'.
 
 +++
 ** When asked to visit a large file, Emacs now offers visiting it literally.

diff --git a/lisp/simple.el b/lisp/simple.el
index 31e3b2bbabadd5d62b67d54f7a3456f9266d662f..ecd7eb797e84132c7f33d76ceff9566fcf2f6004 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1087,7 +1087,7 @@ instead of deleted."
   :group 'killing
   :version "24.1")
 
-(defvar region-extract-function
+(setq region-extract-function
   (lambda (method)
     (when (region-beginning)
       (cond
@@ -1096,19 +1096,7 @@ instead of deleted."
        ((eq method 'delete-only)
         (delete-region (region-beginning) (region-end)))
        (t
-        (filter-buffer-substring (region-beginning) (region-end) method)))))
-  "Function to get the region's content.
-Called with one argument METHOD which can be:
-- nil: return the content as a string (list of strings for
-  non-contiguous regions).
-- `delete-only': delete the region; the return value is undefined.
-- `bounds': return the boundaries of the region as a list of one
-  or more cons cells of the form (START . END).
-- anything else: delete the region and return its content
-  as a string (or list of strings for non-contiguous regions),
-  after filtering it with `filter-buffer-substring', which
-  is called, for each contiguous sub-region, with METHOD as its
-  3rd argument.")
+        (filter-buffer-substring (region-beginning) (region-end) method))))))
 
 (defvar region-insert-function
   (lambda (lines)

diff --git a/src/casefiddle.c b/src/casefiddle.c
index 3a1724b306d403458fc8600d84a93b08af1ad5e7..774906df04defe71153e96cc960685fea84c5bfc 100644 (file)
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -516,34 +516,43 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
   return orig_end + added;
 }
 
-DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 3,
-       "(list (region-beginning) (region-end) (region-noncontiguous-p))",
-       doc: /* Convert the region to upper case.  In programs, wants two arguments.
-These arguments specify the starting and ending character numbers of
-the region to operate on.  When used as a command, the text between
-point and the mark is operated on.
-See also `capitalize-region'.  */)
-  (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
-{
-  Lisp_Object bounds = Qnil;
+/* Casify a possibly noncontiguous region according to FLAG.  BEG and
+   END specify the bounds, except that if REGION_NONCONTIGUOUS_P is
+   non-nil, the region's bounds are specified by (funcall
+   region-extract-function 'bounds) instead.  */
 
+static Lisp_Object
+casify_pnc_region (enum case_action flag, Lisp_Object beg, Lisp_Object end,
+                  Lisp_Object region_noncontiguous_p)
+{
   if (!NILP (region_noncontiguous_p))
     {
-      bounds = call1 (Fsymbol_value (Qregion_extract_function),
-                     intern ("bounds"));
-
-      while (CONSP (bounds))
+      Lisp_Object bounds = call1 (Vregion_extract_function, Qbounds);
+      FOR_EACH_TAIL (bounds)
        {
-         casify_region (CASE_UP, XCAR (XCAR (bounds)), XCDR (XCAR (bounds)));
-         bounds = XCDR (bounds);
+         CHECK_CONS (XCAR (bounds));
+         casify_region (flag, XCAR (XCAR (bounds)), XCDR (XCAR (bounds)));
        }
+      CHECK_LIST_END (bounds, bounds);
     }
   else
-    casify_region (CASE_UP, beg, end);
+    casify_region (flag, beg, end);
 
   return Qnil;
 }
 
+DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 3,
+       "(list (region-beginning) (region-end) (region-noncontiguous-p))",
+       doc: /* Convert the region to upper case.  In programs, wants two arguments.
+These arguments specify the starting and ending character numbers of
+the region to operate on.  When used as a command, the text between
+point and the mark is operated on.
+See also `capitalize-region'.  */)
+  (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
+{
+  return casify_pnc_region (CASE_UP, beg, end, region_noncontiguous_p);
+}
+
 DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 3,
        "(list (region-beginning) (region-end) (region-noncontiguous-p))",
        doc: /* Convert the region to lower case.  In programs, wants two arguments.
@@ -552,23 +561,7 @@ the region to operate on.  When used as a command, the text between
 point and the mark is operated on.  */)
   (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
 {
-  Lisp_Object bounds = Qnil;
-
-  if (!NILP (region_noncontiguous_p))
-    {
-      bounds = call1 (Fsymbol_value (Qregion_extract_function),
-                     intern ("bounds"));
-
-      while (CONSP (bounds))
-       {
-         casify_region (CASE_DOWN, XCAR (XCAR (bounds)), XCDR (XCAR (bounds)));
-         bounds = XCDR (bounds);
-       }
-    }
-  else
-    casify_region (CASE_DOWN, beg, end);
-
-  return Qnil;
+  return casify_pnc_region (CASE_DOWN, beg, end, region_noncontiguous_p);
 }
 
 DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 3,
@@ -580,38 +573,23 @@ In programs, give two arguments, the starting and ending
 character positions to operate on.  */)
   (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
 {
-  Lisp_Object bounds = Qnil;
-
-  if (!NILP (region_noncontiguous_p))
-    {
-      bounds = call1 (Fsymbol_value (Qregion_extract_function),
-                     intern ("bounds"));
-
-      while (CONSP (bounds))
-       {
-         casify_region (CASE_CAPITALIZE, XCAR (XCAR (bounds)), XCDR (XCAR (bounds)));
-         bounds = XCDR (bounds);
-       }
-    }
-  else
-    casify_region (CASE_CAPITALIZE, beg, end);
-
-  return Qnil;
+  return casify_pnc_region (CASE_CAPITALIZE, beg, end, region_noncontiguous_p);
 }
 
 /* Like Fcapitalize_region but change only the initials.  */
 
 DEFUN ("upcase-initials-region", Fupcase_initials_region,
-       Supcase_initials_region, 2, 2, "r",
+       Supcase_initials_region, 2, 3,
+       "(list (region-beginning) (region-end) (region-noncontiguous-p))",
        doc: /* Upcase the initial of each word in the region.
 This means that each word's first character is converted to either
 title case or upper case, and the rest are left unchanged.
 In programs, give two arguments, the starting and ending
 character positions to operate on.  */)
-  (Lisp_Object beg, Lisp_Object end)
+     (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
 {
-  casify_region (CASE_CAPITALIZE_UP, beg, end);
-  return Qnil;
+  return casify_pnc_region (CASE_CAPITALIZE_UP, beg, end,
+                           region_noncontiguous_p);
 }
 \f
 static Lisp_Object
@@ -668,12 +646,28 @@ With negative argument, capitalize previous words but do not move.  */)
 void
 syms_of_casefiddle (void)
 {
+  DEFSYM (Qbounds, "bounds");
   DEFSYM (Qidentity, "identity");
   DEFSYM (Qtitlecase, "titlecase");
   DEFSYM (Qspecial_uppercase, "special-uppercase");
   DEFSYM (Qspecial_lowercase, "special-lowercase");
   DEFSYM (Qspecial_titlecase, "special-titlecase");
 
+  DEFVAR_LISP ("region-extract-function", Vregion_extract_function,
+              doc: /* Function to get the region's content.
+Called with one argument METHOD which can be:
+- nil: return the content as a string (list of strings for
+  non-contiguous regions).
+- `delete-only': delete the region; the return value is undefined.
+- `bounds': return the boundaries of the region as a list of one
+  or more cons cells of the form (START . END).
+- anything else: delete the region and return its content
+  as a string (or list of strings for non-contiguous regions),
+  after filtering it with `filter-buffer-substring', which
+  is called, for each contiguous sub-region, with METHOD as its
+  3rd argument.  */);
+  Vregion_extract_function = Qnil; /* simple.el sets this.  */
+
   defsubr (&Supcase);
   defsubr (&Sdowncase);
   defsubr (&Scapitalize);

diff --git a/src/insdel.c b/src/insdel.c
index 093b841d6d653a8395438cee70ec34e6247c555b..ebfd022ac6bda07cb73f06af8eefbf72d43e5552 100644 (file)
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -2002,7 +2002,7 @@ prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t end,
          : (!NILP (Vselect_active_regions)
             && !NILP (Vtransient_mark_mode))))
     Vsaved_region_selection
-      = call1 (Fsymbol_value (Qregion_extract_function), Qnil);
+      = call1 (Vregion_extract_function, Qnil);
 
   signal_before_change (start, end, preserve_ptr);
   Fset (Qdeactivate_mark, Qt);
@@ -2401,7 +2401,5 @@ handling of the active region per `select-active-regions'.  */);
   inhibit_modification_hooks = 0;
   DEFSYM (Qinhibit_modification_hooks, "inhibit-modification-hooks");
 
-  DEFSYM (Qregion_extract_function, "region-extract-function");
-
   defsubr (&Scombine_after_change_execute);
 }

diff --git a/src/keyboard.c b/src/keyboard.c
index 1b9a603ca17a6c6c2ff8f1093eaf12be36c6de3e..a16d13cc7b822e5799d9874f4402f07a702d6a81 100644 (file)
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1535,7 +1535,7 @@ command_loop_1 (void)
                                  Vselection_inhibit_update_commands)))
                {
                  Lisp_Object txt
-                   = call1 (Fsymbol_value (Qregion_extract_function), Qnil);
+                   = call1 (Vregion_extract_function, Qnil);
                  if (XFIXNUM (Flength (txt)) > 0)
                    /* Don't set empty selections.  */
                    call2 (Qgui_set_selection, QPRIMARY, txt);

diff --git a/src/search.c b/src/search.c
index 9b674a58102dd7097319d6ab2c27badc72fc9dc9..1e57d2ecbe5c9c74de9374287e1871991b050e7f 100644 (file)
--- a/src/search.c
+++ b/src/search.c
@@ -2739,7 +2739,7 @@ since only regular expressions have distinguished subexpressions.  */)
                    Qnil);
   else if (case_action == cap_initial)
     Fupcase_initials_region (make_fixnum (search_regs.start[sub]),
-                            make_fixnum (newpoint));
+                            make_fixnum (newpoint), Qnil);
 
   /* The replace_range etc. functions can trigger modification hooks
      (see signal_before_change and signal_after_change).  Try to error

diff --git a/test/src/casefiddle-tests.el b/test/src/casefiddle-tests.el
index ed9a2f933064470cf7a876fe05930d4fe4d1d68c..54793f2cda4a0caed993d61cbcae8add3615d20a 100644 (file)
--- a/test/src/casefiddle-tests.el
+++ b/test/src/casefiddle-tests.el
@@ -259,5 +259,22 @@
       (should (eq tc (capitalize ch)))
       (should (eq tc (upcase-initials ch))))))
 
+(defvar casefiddle-oldfunc region-extract-function)
+
+(defun casefiddle-loopfunc (method)
+  (if (eq method 'bounds)
+      (let ((looping (list '(1 . 1))))
+        (setcdr looping looping))
+    (funcall casefiddle-oldfunc method)))
+
+(defun casefiddle-badfunc (method)
+  (if (eq method 'bounds)
+      '(())
+    (funcall casefiddle-oldfunc method)))
+
+(ert-deftest casefiddle-invalid-region-extract-function ()
+  (dolist (region-extract-function '(casefiddle-badfunc casefiddle-loopfunc))
+    (with-temp-buffer
+      (should-error (upcase-region nil nil t)))))
 
 ;;; casefiddle-tests.el ends here