|
1695 | 1695 | (testing "other types are never flagged, even with an .ics attachment" |
1696 | 1696 | (is (false? (has-ics :bug))) |
1697 | 1697 | (is (false? (has-ics :patch)))))) |
| 1698 | + |
| 1699 | +;; --------------------------------------------------------------------------- |
| 1700 | +;; report-entity stores :report/patches at creation |
| 1701 | +;; --------------------------------------------------------------------------- |
| 1702 | + |
| 1703 | +(def ^:private format-patch-text |
| 1704 | + (str "From 0123456789abcdef0123456789abcdef01234567 Mon Sep 17 00:00:00 2001\n" |
| 1705 | + "From: Alice <alice@test.org>\n" |
| 1706 | + "Date: Thu, 1 May 2026 10:00:00 +0000\n" |
| 1707 | + "Subject: [PATCH] Fix the parser\n" |
| 1708 | + "\n" |
| 1709 | + "---\n" |
| 1710 | + "diff --git a/parser.el b/parser.el\n")) |
| 1711 | + |
| 1712 | +(deftest report-entity-stores-patches-at-creation |
| 1713 | + (testing "an email with a .patch attachment yields :report/patches" |
| 1714 | + (let [email {:email/attachments [{:attachment/filename "0001-fix.patch" |
| 1715 | + :attachment/content-type "text/x-diff" |
| 1716 | + :attachment/data format-patch-text}] |
| 1717 | + :email/author-address "alice@test.org"} |
| 1718 | + entity (digest/report-entity 1 "<m@test.org>" {:type :patch} nil email nil) |
| 1719 | + patches (:report/patches entity)] |
| 1720 | + (is (= 1 (count patches))) |
| 1721 | + (is (= "0001-fix.patch" (:patch/filename (first patches)))) |
| 1722 | + (is (= :attachment (:patch/source (first patches)))))) |
| 1723 | + (testing "an email without patch content has no :report/patches key" |
| 1724 | + (let [entity (digest/report-entity 1 "<m@test.org>" {:type :bug} nil |
| 1725 | + {:email/author-address "alice@test.org" |
| 1726 | + :email/body-text "it crashes\n"} |
| 1727 | + nil)] |
| 1728 | + (is (not (contains? entity :report/patches)))))) |
| 1729 | + |
| 1730 | +;; --------------------------------------------------------------------------- |
| 1731 | +;; Pending emails surface their patches at creation, without duplication |
| 1732 | +;; on the TTL-flush retry (regression: patches used to wait on Phase 4, |
| 1733 | +;; which pending emails skip) |
| 1734 | +;; --------------------------------------------------------------------------- |
| 1735 | + |
| 1736 | +(deftest pending-patch-stored-at-creation |
| 1737 | + (testing "A [PATCH] reply whose parent is missing gets its patches immediately." |
| 1738 | + (let [{:keys [conn] :as ctx} (setup-db!)] |
| 1739 | + (try |
| 1740 | + (store-and-process! |
| 1741 | + conn |
| 1742 | + (assoc (mk-email {:mid "<pend-patch@test.org>" |
| 1743 | + :subject "[PATCH] Fix the parser" |
| 1744 | + :from "user@test.org" |
| 1745 | + :date #inst "2026-05-01T10:00:00" |
| 1746 | + :in-reply-to "<never-ingested@test.org>" |
| 1747 | + :body "Here is the fix.\n"}) |
| 1748 | + :email/attachments [{:attachment/filename "0001-fix.patch" |
| 1749 | + :attachment/content-type "text/x-diff" |
| 1750 | + :attachment/data format-patch-text}]) |
| 1751 | + "direct") |
| 1752 | + (let [db (d/db conn) |
| 1753 | + r (get-report db "<pend-patch@test.org>")] |
| 1754 | + (is (true? (pending? db "<pend-patch@test.org>")) |
| 1755 | + "Reply should be pending: its parent was never ingested") |
| 1756 | + (is (= ["0001-fix.patch"] (mapv :patch/filename (:report/patches r))) |
| 1757 | + "Patches should be stored at creation despite the pending flag")) |
| 1758 | + |
| 1759 | + ;; TTL-flush retries the pending email; the :store-patches hook |
| 1760 | + ;; must not add duplicate patch components. |
| 1761 | + (digest/flush-stale-pending! conn source-map sources 0) |
| 1762 | + (let [db (d/db conn) |
| 1763 | + r (get-report db "<pend-patch@test.org>")] |
| 1764 | + (is (false? (pending? db "<pend-patch@test.org>")) |
| 1765 | + "Flush should clear the pending flag") |
| 1766 | + (is (= ["0001-fix.patch"] (mapv :patch/filename (:report/patches r))) |
| 1767 | + "Flush retry must not duplicate the stored patches")) |
| 1768 | + (finally |
| 1769 | + (teardown! ctx)))))) |
0 commit comments