github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-30 22:40:33 +00:00
Code Issues Packages Projects Releases Wiki Activity
penpot/backend/test/backend_tests/branch_pointer_base_test.clj
Álvaro Tejero Cantero 7e5099727a
🐛 Make the base the only snapshot a file-gc test relies on 
The save in file-gc-keeps-the-fragments-a-base-names took an automatic
snapshot of pre-edit main, which names the same fragments as the branch
base, so the test passed even with bases left out of liveness. It now
drops every other snapshot before the pass.

AI-assisted-by: claude-opus-5-5
Signed-off-by: Álvaro Tejero Cantero <alvorithm@teje.ro>
2026-10-28 11:48:12 +01:00

311 lines
14 KiB
Clojure
Raw Blame History

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC Sucursal en España SL
(ns backend-tests.branch-pointer-base-test
"A branch base is a snapshot of the source file that shares the source
file's fragments (fdata/pointer-map). Fragment rows are keyed by
`(file_id, id)`, so the base readers must realize it with the source
file id, and the source file's file-gc must keep every fragment a live
base names."
(:require
[app.binfile.common :as bfc]
[app.common.features :as cfeat]
[app.common.files.branch-merge :as bm]
[app.common.types.shape :as cts]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.features.fdata :as fdata]
[app.features.file-snapshots :as fsnap]
[app.rpc :as-alias rpc]
[app.rpc.commands.files-branch :as fbranch]
[app.util.pointer-map :as pmap]
[backend-tests.helpers :as th]
[clojure.test :as t]
[clojure.walk :as walk]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(defn- pointer-map-enabled?
[]
(contains? (cfeat/get-enabled-features cf/flags) "fdata/pointer-map"))
(defn- update-file!
[profile-id file-id changes]
(let [row (th/db-get :file {:id file-id})
out (th/command! {::th/type :update-file
::rpc/profile-id profile-id
:id file-id
:session-id (uuid/random)
:revn (:revn row)
:vern (:vern row)
:features cfeat/supported-features
:changes changes})]
(t/is (nil? (:error out)))
(:result out)))
(defn- add-rect
[page-id]
(let [id (uuid/random)]
{:type :add-obj
:page-id page-id
:id id
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape {:id id
:name "rect"
:frame-id uuid/zero
:parent-id uuid/zero
:type :rect})}))
(defn- create-branch!
[profile-id file-id name]
(let [out (th/command! {::th/type :create-file-branch
::rpc/profile-id profile-id
:file-id file-id
:name name})]
(t/is (nil? (:error out)))
(:result out)))
(defn- live-fragment-ids
[file-id]
(->> (th/db-query :file-data {:file-id file-id :type "fragment"})
(filter #(nil? (:deleted-at %)))
(into #{} (map :id))))
(defn- page-pointer-ids
"{page-id -> fragment id} of decoded file data."
[data]
(into {}
(keep (fn [[id page]]
(when (pmap/pointer-map? page)
[id (pmap/get-id page)])))
(:pages-index data)))
(defn- base-snapshot
[branch-id]
(let [row (th/db-get :file-branch {:id branch-id})]
(fsnap/get-snapshot th/*system* (:source-file-id row) (:base-snapshot-id row))))
(defn- holds-pointers?
[data]
(let [found (volatile! false)]
(walk/prewalk (fn [x]
(when (pmap/pointer-map? x) (vreset! found true))
(if (pmap/pointer-map? x) {} x))
data)
@found))
(defn- realized-data
[file-id]
(:data (bfc/get-file th/*system* file-id :realize? true)))
(defn- setup
[]
(t/is (pointer-map-enabled?) "these tests need fdata/pointer-map")
(let [profile (th/create-profile* 1 {:is-active true})
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
{:profile-id (:id profile) :file-id (:id file)}))
(t/deftest create-stores-the-base-as-source-pointers
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [{:keys [profile-id file-id]} (setup)
before (live-fragment-ids file-id)
branch (create-branch! profile-id file-id "pointers")
base (base-snapshot (:id branch))
ids (page-pointer-ids (:data base))]
;; every page of the base is a pointer into the source file's own
;; fragment rows, and creating the branch wrote no fragment
(t/is (seq ids))
(t/is (= (count ids) (count (:pages-index (:data base)))))
(t/is (every? before (vals ids)))
(t/is (= before (live-fragment-ids file-id))))))
(t/deftest base-readers-realize-with-the-source-file-id
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [{:keys [profile-id file-id]} (setup)
branch (create-branch! profile-id file-id "readers")
;; whatever creation stores, pin a base that holds the source
;; file's pointers: the readers are what this test is about
source (bfc/get-file th/*system* file-id)
_ (t/is (seq (page-pointer-ids (:data source))))
snap (fsnap/create! th/*system* source
{:label "branch-base/readers"
:profile-id profile-id
:created-by "system"})
_ (th/db-update! :file-branch
{:base-snapshot-id (:id snap)}
{:id (:id branch)})
main (realized-data file-id)]
(t/testing "the derive reads the base"
(let [file (bfc/get-file th/*system* (:branch-file-id branch)
:realize? true :include-base-data? true)]
(t/is (not (holds-pointers? (:data file))))
(t/is (= (:pages-index main) (:pages-index (:data file))))
(t/is (not (holds-pointers? (::bfc/base-data file))))
(t/is (= (:pages-index main) (:pages-index (::bfc/base-data file))))))
(t/testing "the snapshot reader reads the base"
(let [row (th/db-get :file-branch {:id (:id branch)})
data (db/run! th/*system* #(#'fbranch/get-base-data % row))]
(t/is (not (holds-pointers? data)))
(t/is (= (:pages-index main) (:pages-index data))))))))
(t/deftest file-gc-keeps-the-fragments-a-base-names
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [{:keys [profile-id file-id]} (setup)
branch (create-branch! profile-id file-id "gc")
page-id (first (:pages (realized-data file-id)))
pinned (set (vals (page-pointer-ids (:data (base-snapshot (:id branch))))))]
(t/is (seq pinned))
;; the edit replaces the page's fragment on main, so only the
;; base still names the old one
(update-file! profile-id file-id [(add-rect page-id)])
(let [main-ids (set (vals (page-pointer-ids
(:data (bfc/get-file th/*system* file-id)))))]
(t/is (seq (remove main-ids pinned))))
;; the save took an automatic snapshot of pre-edit main, which names
;; the same fragments; drop every snapshot but the base so the base
;; is what keeps them alive
(let [base-id (:base-snapshot-id (th/db-get :file-branch {:id (:id branch)}))]
(th/db-exec! ["delete from file_data where file_id = ? and type = 'snapshot' and id <> ?"
file-id base-id])
(th/db-exec! ["delete from file_change where file_id = ? and label is not null and id <> ?"
file-id base-id]))
(t/is (true? (th/run-task! :file-gc {:file-id file-id})))
(t/is (every? (live-fragment-ids file-id) pinned))
(let [diff (:result (th/command! {::th/type :get-branch-diff
::rpc/profile-id profile-id
:branch-id (:id branch)
:direction :main->branch}))]
(t/is (= 1 (-> diff :stats :added)))))))
(t/deftest update-from-main-pins-main-pointers
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [{:keys [profile-id file-id]} (setup)
branch (create-branch! profile-id file-id "update")
page-id (first (:pages (realized-data file-id)))]
(update-file! profile-id file-id [(add-rect page-id)])
(let [out (th/command! {::th/type :update-branch-from-main
::rpc/profile-id profile-id
:branch-id (:id branch)})]
(t/is (nil? (:error out)))
(t/is (= :updated (-> out :result :status))))
;; the repositioned base names main's current fragments for every
;; page the update left equal to main
(let [main-ids (page-pointer-ids (:data (bfc/get-file th/*system* file-id)))
base-ids (page-pointer-ids (:data (base-snapshot (:id branch))))]
(t/is (seq base-ids))
(t/is (= main-ids base-ids)))
(t/is (= (:pages-index (realized-data file-id))
(:pages-index (realized-data (:branch-file-id branch))))))))
(t/deftest merge-keeps-the-fragments-of-untouched-pages
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [{:keys [profile-id file-id]} (setup)
page-a (first (:pages (realized-data file-id)))
page-b (uuid/random)
_ (update-file! profile-id file-id
[{:type :add-page :id page-b :name "B"}])
branch (create-branch! profile-id file-id "merge")
before (page-pointer-ids (:data (bfc/get-file th/*system* file-id)))]
(update-file! profile-id (:branch-file-id branch) [(add-rect page-a)])
(let [out (th/command! {::th/type :merge-file-branch
::rpc/profile-id profile-id
:branch-id (:id branch)})]
(t/is (nil? (:error out)))
(t/is (= :merged (-> out :result :status))))
(let [after (page-pointer-ids (:data (bfc/get-file th/*system* file-id)))]
;; the merged page is new, the untouched one keeps its fragment
(t/is (not= (get before page-a) (get after page-a)))
(t/is (= (get before page-b) (get after page-b)))))))
(defn- rename-shape
[page-id shape-id name]
{:type :mod-obj
:page-id page-id
:id shape-id
:operations [{:type :set :attr :name :val name}]})
(defn- eager-compare
"The comparison with every page of every side realized and no bound."
[file-id branch-file-id dir]
(db/run! th/*system*
(fn [cfg]
(let [main (:data (bfc/get-file cfg file-id :realize? true))
bfile (bfc/get-file cfg branch-file-id :realize? true :include-base-data? true)
base (#'fbranch/branch-base-data cfg file-id bfile)
branch (bm/remap-refs (:data bfile)
(#'fbranch/branch-id-map cfg branch-file-id file-id))]
(bm/compute-merge base main branch dir)))))
(t/deftest compare-loads-only-the-pages-main-moved
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [{:keys [profile-id file-id]} (setup)
page-a (first (:pages (realized-data file-id)))
others (vec (repeatedly 5 uuid/random))
rect (add-rect page-a)
shape (:id rect)
_ (update-file! profile-id file-id
(into [rect]
(map (fn [id] {:type :add-page :id id :name (str id)}))
others))
branch (create-branch! profile-id file-id "lazy")
bfid (:branch-file-id branch)
page-b (first others)]
;; the branch renames the shape main renames too, a conflict on
;; page A, and adds a shape; main also adds a shape on page B, so
;; main moved two of six pages
(update-file! profile-id bfid [(rename-shape page-a shape "branch") (add-rect page-a)])
(update-file! profile-id file-id [(rename-shape page-a shape "main") (add-rect page-b)])
(doseq [dir [:branch->main :main->branch]]
(let [loads (atom 0)
load fdata/load-pointer
out (with-redefs [fdata/load-pointer (fn [& args] (swap! loads inc) (apply load args))]
(th/command! {::th/type :get-branch-diff
::rpc/profile-id profile-id
:branch-id (:id branch)
:direction dir}))
eager (eager-compare file-id bfid dir)]
(t/is (nil? (:error out)))
(t/testing (str dir " gives the summary of the whole-file comparison")
(t/is (= (:stats eager) (:stats (:result out))))
(t/is (= (:changes eager) (:changes (:result out))))
(t/is (= (:conflicts eager) (:conflicts (:result out))))
(t/is (= 1 (count (:conflicts eager)))))
(t/testing (str dir " loads the base's six pages and main's two moved ones")
(t/is (= 8 @loads))))))))
(t/deftest compare-reports-a-page-reorder-on-main
;; the page order lives in the document root, not in a page's fragment,
;; so a reorder moves no fragment and must not bound the comparison
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [{:keys [profile-id file-id]} (setup)
page-b (uuid/random)
_ (update-file! profile-id file-id [{:type :add-page :id page-b :name "B"}])
branch (create-branch! profile-id file-id "reorder")]
(update-file! profile-id file-id [{:type :mov-page :id page-b :index 0}])
(let [out (th/command! {::th/type :get-branch-diff
::rpc/profile-id profile-id
:branch-id (:id branch)
:direction :main->branch})
eager (eager-compare file-id (:branch-file-id branch) :main->branch)]
(t/is (nil? (:error out)))
(t/is (seq (:changes eager)))
(t/is (= (:changes eager) (:changes (:result out))))))))
Reference in New Issue View Git Blame Copy Permalink