From ef23b4706b40401e0212716291b507a1a876d118 Mon Sep 17 00:00:00 2001
From: Ihor Radchenko <yantar92@posteo.net>
Date: Mon, 8 Jan 2024 16:58:24 +0100
Subject: [PATCH] org-babel-tangle: Do not allow tangling into self

* lisp/ob-tangle.el (org-babel-tangle): Throw an error when trying to
tangle into the org file we tangle from.
* etc/ORG-NEWS (It is no longer allowed to tangle into the same file
as Org source): Document the breaking change.
* testing/lisp/test-ob-tangle.el (ob-tangle/tangle-to-self): New test.
---
 etc/ORG-NEWS                   | 12 ++++++++++++
 lisp/ob-tangle.el              | 10 +++++++++-
 testing/lisp/test-ob-tangle.el | 14 ++++++++++++++
 3 files changed, 35 insertions(+), 1 deletion(-)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 6f94c4877..1bf7eb5b4 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -13,6 +13,18 @@ Please send Org bug reports to mailto:emacs-orgmode@gnu.org.
 
 * Version 9.7 (not released yet)
 ** Important announcements and breaking changes
+*** It is no longer allowed to tangle into the same file as Org source
+
+Previously, =file.org= with the following contents
+
+: #+begin_src org :tangle file.org
+: Text
+: #+end_src
+
+would overwrite itself.
+
+Now, an error is thrown.
+
 *** iCalendar export now supports multiline =SUMMARY=, =LOCATION=, and =DESCRIPTION= properties
 
 Previously, it was not possible to specify multi-line location,
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 72089a9a5..281ab13d4 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -256,7 +256,8 @@ matching a regular expression."
 	     (when (equal arg '(16))
 	       (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'no-eval))))
 		   (user-error "Point is not in a source code block"))))
-	    path-collector)
+	    path-collector
+            (source-file buffer-file-name))
 	(mapc ;; map over file-names
 	 (lambda (by-fn)
 	   (let ((file-name (car by-fn)))
@@ -313,6 +314,13 @@ matching a regular expression."
                                       (compare-buffer-substrings
                                        nil nil nil
                                        tangle-buf nil nil)))))))
+                     (when (equal (if (file-name-absolute-p file-name)
+                                      file-name
+                                    (expand-file-name file-name))
+                                  (if (file-name-absolute-p source-file)
+                                      source-file
+                                    (expand-file-name source-file)))
+                       (error "Not allowed to tangle into the same file as self"))
                      ;; We do not erase, but overwrite previous file
                      ;; to preserve any existing symlinks.
 		     (write-region nil nil file-name)
diff --git a/testing/lisp/test-ob-tangle.el b/testing/lisp/test-ob-tangle.el
index 22d88c38f..705413698 100644
--- a/testing/lisp/test-ob-tangle.el
+++ b/testing/lisp/test-ob-tangle.el
@@ -553,6 +553,20 @@ another block
                     (org-split-string (buffer-string))))
               (delete-file file))))))
 
+(ert-deftest ob-tangle/tangle-to-self ()
+  "Do not allow tangling into self."
+  (let ((file (make-temp-file "org-tangle-" nil ".org")))
+    (unwind-protect
+        (with-current-buffer (find-file-noselect file)
+          (insert
+           (format "
+#+begin_src elisp :tangle %s
+2
+#+end_src
+" file))
+          (should-error (org-babel-tangle)))
+      (delete-file file))))
+
 (ert-deftest ob-tangle/detangle-false-positive ()
   "Test handling of false positive link during detangle."
   (let (buffer)