Merge pull request bakaq#44 from jjtolton/main

Fix relative path resolution for pkg() imports in subdirectories

Author: bakaq

bakage.pl

@@ -27,7 +27,7 @@
 :- use_module(library(os), [argv/1, setenv/2, shell/1, unsetenv/1, getenv/2]).
 :- use_module(library(files), [
     directory_exists/1, make_directory_path/1, directory_files/2, file_exists/1,
-    delete_file/1, delete_directory/1
+    delete_file/1, delete_directory/1, working_directory/2
 ]).
 :- use_module(library(dcgs), [phrase/2, phrase/3, ... //0]). % 13211-3
 :- use_module(library(charsio), [write_term_to_chars/3]).
@@ -356,10 +356,78 @@
 define_script_arg(Arg-Value) :- setenv(Arg, Value).
 undefine_script_arg(Arg-_) :- unsetenv(Arg).
 
+% join_sep_split/3: Monotonic join and split by separator.
+% Implementation by @bakaq from https://github.com/mthom/scryer-prolog/discussions/3121
+%
+% True when `Joined` is a list consisting of all the lists in `Segments`
+% separated by `Separator`, and `Separator` doesn't appear in any of the
+% lists in `Segments`. Can be used as both a split and a join depending
+% on the mode.
+join_sep_split(Joined, Separator, Segments) :-
+    join_sep_split_(Separator, Joined, Segments).
+
+% The empty separator case is just append/2
+join_sep_split_([], Joined, Segments) :-
+    append(Segments, Joined).
+join_sep_split_([S|Ss], Joined, Segments) :-
+    join_sep_split(Joined, [], [S|Ss], Segments, []).
+
+% Stuff like this that needs 2 list differences is hard to encode
+% in a DCG in my experience.
+join_sep_split([], [], _, [], []).
+join_sep_split([L0|LT0], Ls, Sep, [Seg|Segs0], Segs) :-
+    Ls0 = [L0|LT0],
+    next_segment(Ls0, Seg, Sep, Ls1, Reason),
+    join_sep_split_(Ls1, Ls, Sep, Segs0, Segs, Reason).
+
+join_sep_split_([], [], _, Segs0, Segs, Reason) :-
+    reason_segs(Reason, Segs0, Segs).
+join_sep_split_([L0|LT0], Ls, Sep, Segs0, Segs, _) :-
+    join_sep_split([L0|LT0], Ls, Sep, Segs0, Segs).
+
+reason_segs(sep, [[]|Segs], Segs).
+reason_segs(end, Segs, Segs).
+
+next_segment([], [], _, [], end).
+next_segment([L0|Ls0], Seg, Sep, Ls, Reason) :-
+    if_(
+        starts_with_t(Sep, [L0|Ls0], Ls1),
+        (Ls = Ls1, Seg = [], Reason = sep),
+        (Seg = [L0|Seg1], next_segment(Ls0, Seg1, Sep, Ls, Reason))
+    ).
+
+starts_with_t([], Ls, Ls, true).
+starts_with_t([S|Ss], Ls0, Ls, T) :-
+    starts_with_t_(Ls0, Ls, S, Ss, T).
+
+starts_with_t_([], _, _, _, false).
+starts_with_t_([L|Ls0], Ls, S, Ss, T) :-
+    if_(
+        S = L,
+        starts_with_t(Ss, Ls0, Ls, T),
+        T = false
+    ).
+
+find_project_root(Root) :-
+    working_directory(CWD, CWD),
+    find_project_root_from(CWD, Root).
+
+find_project_root_from(Dir, Root) :-
+    append(Dir, "/scryer-manifest.pl", ManifestPath),
+    (   file_exists(ManifestPath) ->
+        Root = Dir
+    ;   join_sep_split(Dir, "/", Segments),
+        append(ParentSegments, [_LastSegment], Segments),
+        ParentSegments \= [],
+        join_sep_split(ParentDir, "/", ParentSegments),
+        find_project_root_from(ParentDir, Root)
+    ).
+
 scryer_path(ScryerPath) :-
-    (   getenv("SCRYER_PATH", ScryerPath) ->
-        true
-    ;   ScryerPath = "scryer_libs"
+    (   getenv("SCRYER_PATH", EnvPath) ->
+        ScryerPath = EnvPath
+    ;   find_project_root(RootChars),
+        append([RootChars, "/scryer_libs"], ScryerPath)
     ).
 
 % the message sent to the user when a dependency is malformed

tests/snapshot/cases/subdirectory_imports.in/my_module.pl

@@ -0,0 +1,6 @@
+:- module(my_module, [greet/1]).
+
+greet(Name) :-
+    write('Hello, '),
+    write(Name),
+    write('!'), nl.

tests/snapshot/cases/subdirectory_imports.in/scryer-manifest.pl

@@ -0,0 +1,5 @@
+name("bakage-repro").
+
+dependencies([
+    dependency("testing", git("https://github.com/bakaq/testing.pl.git"))
+]).

tests/snapshot/cases/subdirectory_imports.in/tests/test_my_module.pl

@@ -0,0 +1,7 @@
+:- use_module('../../../../../bakage.pl').
+:- use_module(pkg(testing)).
+:- use_module('../my_module.pl').
+
+test("greet succeeds", (
+    greet('World')
+)).

tests/snapshot/cases/subdirectory_imports.sh

@@ -0,0 +1,17 @@
+#!/bin/sh
+
+bakage() {
+    ../../../../bakage.pl "$@"
+}
+
+echo "=== Installing dependencies ==="
+bakage install
+
+echo ""
+echo "=== Running test from project root ==="
+scryer-prolog tests/test_my_module.pl -g "run_tests, halt."
+
+echo ""
+echo "=== Running test from subdirectory ==="
+cd tests
+scryer-prolog test_my_module.pl -g "run_tests, halt."

tests/snapshot/cases/subdirectory_imports.status

@@ -0,0 +1 @@
+0

tests/snapshot/cases/subdirectory_imports.stderr

@@ -0,0 +1,12 @@
+=== Installing dependencies ===
+Ensuring is installed: git("https://github.com/bakaq/testing.pl.git")
+
+=== Running test from project root ===
+Running tests in module user.
+  test "greet succeeds" ... Hello, World!
+succeeded
+
+=== Running test from subdirectory ===
+Running tests in module user.
+  test "greet succeeds" ... Hello, World!
+succeeded