From 271dd47610d8f7bb40ee2fd6f0ee18f1dfdf0456 Mon Sep 17 00:00:00 2001
From: Dave Aitken <dave.aitken@gmail.com>
Date: Tue, 12 Jul 2022 15:44:01 +0100
Subject: [PATCH] Resolve path from workspace rather than using absolute path

- This fixes the behavior of `ppx_blob` for Dune lang 3 so that it's the
  same as with Dune lang 1.
- Dune lang is updated to 1.11 for easier testing (`explicit_js_mode`).
---
 dune-project                            |  3 ++-
 integration-test/dune-lang-3/src/foo.ml | 14 +++++++-------
 ppx_blob.opam                           |  2 +-
 src/ppx_blob.ml                         |  6 +++---
 test/dune                               | 14 ++++----------
 test/subdir/dune                        |  5 +++++
 test/subdir/test.ml                     | 14 ++++++++++++++
 test/subdir/test_file                   |  1 +
 test/test.ml                            |  5 ++++-
 test/test_file                          |  2 +-
 10 files changed, 42 insertions(+), 24 deletions(-)
 create mode 100644 test/subdir/dune
 create mode 100644 test/subdir/test.ml
 create mode 100644 test/subdir/test_file

diff --git a/dune-project b/dune-project
index 09ede06..593dcf2 100644
--- a/dune-project
+++ b/dune-project
@@ -1,2 +1,3 @@
-(lang dune 1.6)
+(lang dune 1.11)
 (name ppx_blob)
+(explicit_js_mode)
diff --git a/integration-test/dune-lang-3/src/foo.ml b/integration-test/dune-lang-3/src/foo.ml
index 7cd9a11..d7fbbda 100644
--- a/integration-test/dune-lang-3/src/foo.ml
+++ b/integration-test/dune-lang-3/src/foo.ml
@@ -13,21 +13,21 @@ let () =
     List.exists Result.is_error
       [
         (* Path relative to this file *)
-        (* check ~path:"../root.inc" ~expected:"included-root"
-          ~actual:[%blob "../root.inc"]; *)
-        (* check ~path:"src.inc" ~expected:"included-src" ~actual:[%blob "src.inc"]; *)
+        check ~path:"../root.inc" ~expected:"included-root"
+          ~actual:[%blob "../root.inc"];
+        check ~path:"src.inc" ~expected:"included-src" ~actual:[%blob "src.inc"];
         (* Path relative to build directory *)
         check ~path:"root.inc" ~expected:"included-root"
           ~actual:[%blob "root.inc"];
         check ~path:"src/src.inc" ~expected:"included-src"
           ~actual:[%blob "src/src.inc"];
         (* Ambiguous path *)
-        check ~path:"common.inc" ~expected:"included-common-root" (* violates precedence *)
+        check ~path:"common.inc" ~expected:"included-common-src"
           ~actual:[%blob "common.inc"];
-        (* check ~path:"../common.inc" ~expected:"included-common-root"
-          ~actual:[%blob "../common.inc"]; *)
+        check ~path:"../common.inc" ~expected:"included-common-root"
+          ~actual:[%blob "../common.inc"];
         (* Absolute path *)
-        check ~path:"/etc/hostname" ~expected:(input_line (open_in "/etc/hostname"))
+        check ~path:"/etc/hostname" ~expected:"included-hostname"
           ~actual:[%blob "/etc/hostname"];
       ]
   then exit 1
diff --git a/ppx_blob.opam b/ppx_blob.opam
index 5459630..5dcd8a1 100644
--- a/ppx_blob.opam
+++ b/ppx_blob.opam
@@ -11,7 +11,7 @@ build: [
 ]
 depends: [
   "ocaml"
-  "dune" {>= "1.6"}
+  "dune" {>= "1.11"}
   "ppxlib"
   "alcotest" {with-test}
 ]
diff --git a/src/ppx_blob.ml b/src/ppx_blob.ml
index df99484..7a3c501 100644
--- a/src/ppx_blob.ml
+++ b/src/ppx_blob.ml
@@ -6,9 +6,9 @@ let location_errorf ~loc =
   )
 
 let find_file_path ~loc file_name =
-  let dirname = Ocaml_common.Location.absolute_path loc.Ocaml_common.Location.loc_start.pos_fname |> Filename.dirname in
-  let absolute_path = Filename.concat dirname file_name in
-  List.find Sys.file_exists [absolute_path; file_name]
+  let dirname = loc.Ocaml_common.Location.loc_start.pos_fname |> Filename.dirname in
+  let relative_path = Filename.concat dirname file_name in
+  List.find Sys.file_exists [relative_path; file_name]
 
 let get_blob ~loc file_name =
   try
diff --git a/test/dune b/test/dune
index edcb9cc..b3b4932 100644
--- a/test/dune
+++ b/test/dune
@@ -1,11 +1,5 @@
-(executable
- (name test)
+(tests
+ (libraries alcotest)
+ (preprocessor_deps (file test_file) (file subdir/test_file))
  (preprocess (pps ppx_blob))
- (preprocessor_deps (file test_file))
- (libraries alcotest))
-
-(alias
- (name runtest)
- (deps (:test test.exe))
- (action (run %{test})))
-
+ (names test))
diff --git a/test/subdir/dune b/test/subdir/dune
new file mode 100644
index 0000000..1cc3ce2
--- /dev/null
+++ b/test/subdir/dune
@@ -0,0 +1,5 @@
+(tests
+ (libraries alcotest)
+ (preprocessor_deps (file test_file) (file ../test_file))
+ (preprocess (pps ppx_blob))
+ (names test))
diff --git a/test/subdir/test.ml b/test/subdir/test.ml
new file mode 100644
index 0000000..38fffef
--- /dev/null
+++ b/test/subdir/test.ml
@@ -0,0 +1,14 @@
+let suite = [
+    ("path relative to source file", `Quick, fun () ->
+      Alcotest.(check string) "file contents" "test/subdir/test_file\n" [%blob "test_file"]
+    );
+
+    ("path relative to source file (parent dir)", `Quick, fun () ->
+      Alcotest.(check string) "file contents" "test/test_file\n" [%blob "../test_file"]
+    );
+  ]
+
+let () =
+  Alcotest.run "ppx_blob" [
+    "basic", suite
+  ]
diff --git a/test/subdir/test_file b/test/subdir/test_file
new file mode 100644
index 0000000..6e88b75
--- /dev/null
+++ b/test/subdir/test_file
@@ -0,0 +1 @@
+test/subdir/test_file
diff --git a/test/test.ml b/test/test.ml
index 8569593..030bbbf 100644
--- a/test/test.ml
+++ b/test/test.ml
@@ -1,6 +1,9 @@
 let suite = [
   ("path relative to source file", `Quick, fun () ->
-    Alcotest.(check string) "file contents" "foo\n" [%blob "test_file"]
+    Alcotest.(check string) "file contents" "test/test_file\n" [%blob "test_file"]
+  );
+  ("path relative to source file (subdir)", `Quick, fun () ->
+    Alcotest.(check string) "file contents" "test/subdir/test_file\n" [%blob "subdir/test_file"]
   );
 ]
 
diff --git a/test/test_file b/test/test_file
index 257cc56..0c77977 100644
--- a/test/test_file
+++ b/test/test_file
@@ -1 +1 @@
-foo
+test/test_file