diff --git a/lisp/subr.el b/lisp/subr.el
index d97598ab61f..08eee8646a4 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -5664,10 +5664,17 @@ the function `undo--wrap-and-run-primitive-undo'."
   (if (markerp beg) (setq beg (marker-position beg)))
   (if (markerp end) (setq end (marker-position end)))
   (let ((old-bul buffer-undo-list)
+        (beg-marker (copy-marker beg))
+        (unchanged-after (- (point-max) end))
 	(end-marker (copy-marker end t))
 	result)
     (if undo--combining-change-calls
-	(setq result (funcall body))
+        (progn
+	  (setq result (funcall body))
+          (unless (and (= beg-marker beg)
+                       (= unchanged-after (- (point-max) end-marker)))
+            (error "Modifications outside the announced region"))
+          (set-marker beg-marker nil))
       (let ((undo--combining-change-calls t))
 	(if (not inhibit-modification-hooks)
 	    (run-hook-with-args 'before-change-functions beg end))
@@ -5686,7 +5693,11 @@ the function `undo--wrap-and-run-primitive-undo'."
                             (if (memq #'syntax-ppss-flush-cache bcf)
                                 '(syntax-ppss-flush-cache)))
                 (setq-local after-change-functions nil)
-	        (setq result (funcall body)))
+	        (setq result (funcall body))
+                (unless (and (= beg-marker beg)
+                             (= unchanged-after (- (point-max) end-marker)))
+                  (error "Modifications outside the announced region"))
+                (set-marker beg-marker nil))
 	    (if local-bcf (setq before-change-functions bcf)
 	      (kill-local-variable 'before-change-functions))
 	    (if local-acf (setq after-change-functions acf)
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index b99328459d6..b6e9eb92855 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1773,5 +1773,24 @@ The argument names are important."
                                                          '("foo" "bar" "bazzzzzz"))
                    '(("foo" "bar") ("bazzzzzz"))))))
 
+(ert-deftest subr-test-combine-change-calls-error ()
+  "Test detection of unexpected changes in `combine-change-calls'."
+  (with-temp-buffer
+    (insert "a\nb\nc\n")
+    (combine-change-calls 3 5
+      (goto-char (point-min))
+      (search-forward "b")
+      (replace-match "bbb"))
+    (should-error
+     (combine-change-calls 3 7
+      (goto-char (point-min))
+      (search-forward "a")
+      (replace-match "aaa")))
+    (should-error
+     (combine-change-calls 5 9
+      (goto-char (point-min))
+      (search-forward "c")
+      (replace-match "ccc")))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here