GNU bug report logs - #68935
[PATCH 0/3] Add 'put' option to guix import.

Previous Next

Full log

View this message in rfc822 format

From: Herman Rimm <herman <at> rimm.ee>
To: 68935 <at> debbugs.gnu.org
Cc: ludo <at> gnu.org, Herman Rimm <herman <at> rimm.ee>, Christopher Baines <guix <at> cbaines.net>, Josselin Poiret <dev <at> jpoiret.xyz>, Ludovic Courtès <ludo <at> gnu.org>, Mathieu Othacehe <othacehe <at> gnu.org>, Ricardo Wurmus <rekado <at> elephly.net>, Simon Tournier <zimon.toutoune <at> gmail.com>, Tobias Geerinckx-Rice <me <at> tobias.gr>
Subject: [bug#68935] [PATCH v3 4/7] utils: Add find-definition-insertion-location procedure.
Date: Tue, 20 Feb 2024 21:45:12 +0100

* guix/utils.scm (find-definition-insertion-location): Add and export
procedure.
* tests/utils.scm ("find-definition-insertion-location"): Add test.

Change-Id: Ie17e1b4a94790f58518ce121411a38d357f49feb
---
 guix/utils.scm  | 19 +++++++++++++++++++
 tests/utils.scm | 14 ++++++++++++++
 2 files changed, 33 insertions(+)

diff --git a/guix/utils.scm b/guix/utils.scm
index 8f0bc2399e..82a78e2dfb 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -148,6 +148,7 @@ (define-module (guix utils)
             edit-expression
             delete-expression
             insert-expression
+            find-definition-insertion-location
 
             filtered-port
             decompressed-port
@@ -513,6 +514,24 @@ (define (insert-expression source-properties expr)
                    (string-append expr "\n\n" str))))
     (edit-expression source-properties insert)))
 
+(define (find-definition-insertion-location file term)
+  "Search in FILE for a top-level public definition whose defined term
+alphabetically succeeds TERM. Return the location if found, or #f
+otherwise."
+  (let ((search-term (symbol->string term)))
+    (call-with-input-file file
+      (lambda (port)
+        (do ((syntax (read-syntax port)
+                     (read-syntax port)))
+          ((match (syntax->datum syntax)
+             (('define-public current-term _ ...)
+              (string> (symbol->string current-term)
+                       search-term))
+             ((? eof-object?) #t)
+             (_ #f))
+           (and (not (eof-object? syntax))
+                (syntax-source syntax))))))))
+
 
 ;;;
 ;;; Keyword arguments.
diff --git a/tests/utils.scm b/tests/utils.scm
index cd54112846..52f3b58ede 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -288,6 +288,20 @@ (define-public package-2\n  'package)\n"
                        `(define-public package-1 'package))
     (call-with-input-file temp-file get-string-all)))
 
+(test-equal "find-definition-insertion-location"
+  (list `((filename . ,temp-file) (line . 0) (column . 0))
+        `((filename . ,temp-file) (line . 5) (column . 0))
+        #f)
+  (begin
+    (call-with-output-file temp-file
+      (lambda (port)
+        (display "(define-public package-1\n  'foo)\n\n" port)
+        (display "(define foo 'bar)\n\n" port)
+        (display "(define-public package-2\n  'baz)\n" port)))
+    (map (lambda (term)
+           (find-definition-insertion-location temp-file term))
+         (list 'package 'package-1 'package-2))))
+
 (test-equal "string-distance"
   '(0 1 1 5 5)
   (list
-- 
2.41.0

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.