From b9a0f1d6935e4ef3d69310dc08f62965ca6dafec Mon Sep 17 00:00:00 2001 From: Chris Cannam Date: Thu, 4 Apr 2024 12:15:00 +0100 Subject: [PATCH] Tests and fixes for local branch handling --- repoint.sml | 53 ++++++++++++++++++++++++------------------- src/git.sml | 51 +++++++++++++++++++++++------------------ src/version.sml | 2 +- test/tests/include.sh | 10 ++++++++ 4 files changed, 70 insertions(+), 46 deletions(-) diff --git a/repoint.sml b/repoint.sml index 57c8bec..a9332fb 100644 --- a/repoint.sml +++ b/repoint.sml @@ -38,7 +38,7 @@ authorization. *) -val repoint_version = "1.4" +val repoint_version = "1.5" datatype vcs = @@ -1560,14 +1560,16 @@ structure GitControl :> VCS_CONTROL = struct fun ids_match id1 id2 = String.isPrefix id1 id2 orelse String.isPrefix id2 id1 - + + fun is_commit_at context (libname, id_or_tag) id = + if ids_match id_or_tag id + then OK true + else is_at_tag context (libname, id, id_or_tag) + fun is_at context (libname, id_or_tag) = case id_of context libname of ERROR e => OK false (* HEAD nonexistent, expected in empty repo *) - | OK id => - if ids_match id_or_tag id - then OK true - else is_at_tag context (libname, id, id_or_tag) + | OK id => is_commit_at context (libname, id_or_tag) id fun branch_tip context (libname, branch_name) = (* We don't have access to the source info or the network @@ -1601,6 +1603,16 @@ structure GitControl :> VCS_CONTROL = struct | OK false => is_branch_ancestor context (libname, branch_name) "HEAD" + fun is_commit_tip_or_ancestor_by_name context (libname, branch_name) id = + case branch_tip context (libname, branch_name) of + ERROR e => OK false + | OK rev => + case is_commit_at context (libname, rev) id of + ERROR e => ERROR e + | OK true => OK true + | OK false => + is_branch_ancestor context (libname, branch_name) id + fun is_on_branch context (libname, branch) = let val branch_name = local_branch_name context (libname, branch) in @@ -1671,20 +1683,19 @@ structure GitControl :> VCS_CONTROL = struct end (* Generally speaking, when updating to a new commit from a remote - branch, we can reset the local branch to that commit if (a) it - was previously pointing at an ancestor of it or (b) the current - HEAD is on a different branch entirely. Otherwise it's possible - the user has made some unpushed commits locally that we would - lose, and we should avoid moving the local branch. *) + branch, we can reset the local branch to that commit only if it + was previously pointing at an ancestor of it. Otherwise it's + possible the user has made some unpushed commits locally that + we would lose, and we should avoid moving the local branch. *) fun can_reset_for context (libname, branch_name) = - case is_tip_or_ancestor_by_name context (libname, branch_name) of + case git_command_output context libname ["rev-parse", branch_name] of ERROR _ => true - | OK true => true - | OK false => - case symbolic_id_of context libname of - ERROR e => true - | OK id => id <> "HEAD" andalso id <> branch_name + | OK id => + case is_commit_tip_or_ancestor_by_name + context (libname, branch_name) id of + ERROR _ => true + | OK result => result (* This function updates to the latest revision on a branch rather than to a specific id or tag. We can't just checkout the given @@ -1717,12 +1728,8 @@ structure GitControl :> VCS_CONTROL = struct end (* This function is dealing with a specific id or tag, so if we - can successfully check it out (detached) then that's all we - need to do, regardless of whether fetch succeeded or not. We do - attempt the fetch first, though, purely in order to avoid ugly - error messages in the common case where we're being asked to - update to a new pin (from the lock file) that hasn't been - fetched yet. As with update, we reset the local branch if + can successfully check it out then that's all we strictly need + to do. As with update, we reset the local branch if can_reset_for says we can, but with the extra condition that the commit we're resetting to is also on the given branch. *) diff --git a/src/git.sml b/src/git.sml index 0e368ec..d906b51 100644 --- a/src/git.sml +++ b/src/git.sml @@ -118,14 +118,16 @@ structure GitControl :> VCS_CONTROL = struct fun ids_match id1 id2 = String.isPrefix id1 id2 orelse String.isPrefix id2 id1 - + + fun is_commit_at context (libname, id_or_tag) id = + if ids_match id_or_tag id + then OK true + else is_at_tag context (libname, id, id_or_tag) + fun is_at context (libname, id_or_tag) = case id_of context libname of ERROR e => OK false (* HEAD nonexistent, expected in empty repo *) - | OK id => - if ids_match id_or_tag id - then OK true - else is_at_tag context (libname, id, id_or_tag) + | OK id => is_commit_at context (libname, id_or_tag) id fun branch_tip context (libname, branch_name) = (* We don't have access to the source info or the network @@ -159,6 +161,16 @@ structure GitControl :> VCS_CONTROL = struct | OK false => is_branch_ancestor context (libname, branch_name) "HEAD" + fun is_commit_tip_or_ancestor_by_name context (libname, branch_name) id = + case branch_tip context (libname, branch_name) of + ERROR e => OK false + | OK rev => + case is_commit_at context (libname, rev) id of + ERROR e => ERROR e + | OK true => OK true + | OK false => + is_branch_ancestor context (libname, branch_name) id + fun is_on_branch context (libname, branch) = let val branch_name = local_branch_name context (libname, branch) in @@ -229,20 +241,19 @@ structure GitControl :> VCS_CONTROL = struct end (* Generally speaking, when updating to a new commit from a remote - branch, we can reset the local branch to that commit if (a) it - was previously pointing at an ancestor of it or (b) the current - HEAD is on a different branch entirely. Otherwise it's possible - the user has made some unpushed commits locally that we would - lose, and we should avoid moving the local branch. *) + branch, we can reset the local branch to that commit only if it + was previously pointing at an ancestor of it. Otherwise it's + possible the user has made some unpushed commits locally that + we would lose, and we should avoid moving the local branch. *) fun can_reset_for context (libname, branch_name) = - case is_tip_or_ancestor_by_name context (libname, branch_name) of + case git_command_output context libname ["rev-parse", branch_name] of ERROR _ => true - | OK true => true - | OK false => - case symbolic_id_of context libname of - ERROR e => true - | OK id => id <> "HEAD" andalso id <> branch_name + | OK id => + case is_commit_tip_or_ancestor_by_name + context (libname, branch_name) id of + ERROR _ => true + | OK result => result (* This function updates to the latest revision on a branch rather than to a specific id or tag. We can't just checkout the given @@ -275,12 +286,8 @@ structure GitControl :> VCS_CONTROL = struct end (* This function is dealing with a specific id or tag, so if we - can successfully check it out (detached) then that's all we - need to do, regardless of whether fetch succeeded or not. We do - attempt the fetch first, though, purely in order to avoid ugly - error messages in the common case where we're being asked to - update to a new pin (from the lock file) that hasn't been - fetched yet. As with update, we reset the local branch if + can successfully check it out then that's all we strictly need + to do. As with update, we reset the local branch if can_reset_for says we can, but with the extra condition that the commit we're resetting to is also on the given branch. *) diff --git a/src/version.sml b/src/version.sml index c33ef4d..312d360 100644 --- a/src/version.sml +++ b/src/version.sml @@ -32,5 +32,5 @@ authorization. *) -val repoint_version = "1.4" +val repoint_version = "1.5" diff --git a/test/tests/include.sh b/test/tests/include.sh index 5f8b3ee..96ce18c 100755 --- a/test/tests/include.sh +++ b/test/tests/include.sh @@ -98,6 +98,16 @@ check_id() { fi } +check_string() { + local actual="$1" + local expected="$2" + local context="$3" + if [ "$actual" != "$expected" ]; then + echo "ERROR: incorrect $context: actual value ($actual) does not match expected ($expected)" + exit 3 + fi +} + check_expected_with_extpath() { echo "Checking external repo IDs against expected values..." local extpath="$1"