From e120fc39aca45d55ede90b4200b7b9e39bc83e1e Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide Date: Fri, 18 Aug 2023 19:25:59 +0200 Subject: [PATCH 21/21] SRFI-119 (Wisp): add tests for equality of source-properties and fix them * test-suite/tests/srfi-119.test (scheme->list): new procedure * test-suite/tests/srfi-119.test (wisp-source-properties): use pass-if (every pair? ...) for the existance test. Use scheme->list to compare source-properties from regular Scheme read and wisp read. * module/language/wisp.scm (line-code): replace custom logic with wisp-add-source-properties-from/when-required * module/language/wisp.scm (wisp-scheme-read-chunk-lines): set the line-number from the start of the chunk as source-property instead of the line number from the end of the chunk. --- module/language/wisp.scm | 57 ++++++++++++++++++---------------- test-suite/tests/srfi-119.test | 19 ++++++++++-- 2 files changed, 48 insertions(+), 28 deletions(-) diff --git a/module/language/wisp.scm b/module/language/wisp.scm index 3b14eba54..dae9642ae 100644 --- a/module/language/wisp.scm +++ b/module/language/wisp.scm @@ -45,6 +45,24 @@ (read-enable 'curly-infix)) +;; Helpers to preserver source properties + +(define (wisp-add-source-properties-from source target) + "Copy the source properties from source into the target and return the target." + (catch #t + (lambda () + (set-source-properties! target (source-properties source))) + (lambda (key . arguments) + #f)) + target) + +(define (wisp-add-source-properties-from/when-required source target) + "Copy the source properties if target has none." + (if (null? (source-properties target)) + (wisp-add-source-properties-from source target) + target)) + + ;; Helper functions for the indent-and-symbols data structure: '((indent token token ...) ...) (define make-line list) @@ -63,7 +81,7 @@ (let ((code (cdr line))) ;; propagate source properties (when (not (null? code)) - (set-source-properties! code (source-properties line))) + (wisp-add-source-properties-from/when-required line code)) code)) ;; literal values I need @@ -204,14 +222,16 @@ (define (wisp-scheme-read-chunk-lines port) - (let loop - ((indent-and-symbols (list)); '((5 "(foobar)" "\"yobble\"")(3 "#t")) - (in-indent? #t) - (in-underscoreindent? (equal? #\_ (peek-char port))) - (in-comment? #f) - (currentindent 0) - (currentsymbols '()) - (emptylines 0)) + ;; the line number for this chunk is the line number when starting to read it + ;; a top-level form stops processing, so we only need to retrieve this here. + (define line-number (port-line port)) + (let loop ((indent-and-symbols (list)); '((5 "(foobar)" "\"yobble\"")(3 "#t")) + (in-indent? #t) + (in-underscoreindent? (equal? #\_ (peek-char port))) + (in-comment? #f) + (currentindent 0) + (currentsymbols '()) + (emptylines 0)) (cond ((>= emptylines 2) ;; the chunk end has to be checked @@ -226,7 +246,7 @@ ((eof-object? next-char) (let ((line (apply make-line currentindent currentsymbols))) (set-source-property! line 'filename (port-filename port)) - (set-source-property! line 'line (port-line port)) + (set-source-property! line 'line line-number) (append indent-and-symbols (list line)))) ((and in-indent? (zero? currentindent) @@ -296,7 +316,7 @@ (when (not (= 0 (length (line-code parsedline)))) ;; set the source properties to parsedline so we can try to add them later. (set-source-property! parsedline 'filename (port-filename port)) - (set-source-property! parsedline 'line (port-line port))) + (set-source-property! parsedline 'line line-number)) ;; TODO: If the line is empty. Either do it here and do not add it, just ;; increment the empty line counter, or strip it later. Replace indent ;; -1 by indent 0 afterwards. @@ -405,21 +425,6 @@ #f))) l)) -(define (wisp-add-source-properties-from source target) - "Copy the source properties from source into the target and return the target." - (catch #t - (lambda () - (set-source-properties! target (source-properties source))) - (lambda (key . arguments) - #f)) - target) - -(define (wisp-add-source-properties-from/when-required source target) - "Copy the source properties if target has none." - (if (null? (source-properties target)) - (wisp-add-source-properties-from source target) - target)) - (define (wisp-propagate-source-properties code) "Propagate the source properties from the sourrounding list into every part of the code." (let loop ((processed '()) diff --git a/test-suite/tests/srfi-119.test b/test-suite/tests/srfi-119.test index 64ccc2ff6..60e1e0377 100644 --- a/test-suite/tests/srfi-119.test +++ b/test-suite/tests/srfi-119.test @@ -19,6 +19,7 @@ (define-module (test-srfi-119) #:use-module (test-suite lib) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) ;; cut #:use-module (language wisp)) (define (read-string s) @@ -36,6 +37,14 @@ (define (wisp->list str) (wisp-scheme-read-string str)) +(define (scheme->list str) + (with-input-from-string str + (λ () + (let loop ((result '())) + (if (eof-object? (peek-char)) + (reverse! result) + (loop (cons (read) result))))))) + (with-test-prefix "wisp-read-simple" (pass-if-equal '((<= n 5)) (wisp->list "<= n 5")) @@ -89,5 +98,11 @@ _ display \"hello\n\" (wisp->list "1 . 2\n3 4\n 5 . 6"))) (with-test-prefix "wisp-source-properties" - (pass-if (not (find null? (map source-properties (wisp->list "1 . 2\n3 4\n 5 . 6"))))) - (pass-if (not (find null? (map source-properties (wisp->list "1 2\n3 4\n 5 6")))))) + ;; has properties + (pass-if (every pair? (map source-properties (wisp->list "1 . 2\n3 4\n 5 . 6")))) + (pass-if (every pair? (map source-properties (wisp->list "1 2\n3 4\n 5 6")))) + ;; has the same properties + (pass-if-equal + (map source-properties (scheme->list "(1 . 2)\n(3 4\n (5 . 6))\n(1 4)\n\n(7 8)")) + (map (cut cons '(filename . #f) <>) + (map source-properties (wisp->list "1 . 2\n3 4\n 5 . 6\n1 4\n\n7 8"))))) -- 2.41.0