From a4ccd0287afdb9bca20f022e94f6b63c2e8fbd64 Mon Sep 17 00:00:00 2001 From: Michael Herstine Date: Sat, 6 Jan 2024 16:15:48 -0800 Subject: [PATCH] Pretty-print ) out) + "Pretty-print instances" + (display "" out)) + (make-symbol "unknown-frame") (make-symbol "album-frame") ;; TAL/TALB @@ -226,6 +232,18 @@ at `root'" (frames #:init-value '() #:accessor frames #:init-keyword #:frames) (padding #:init-value 0 #:accessor padding #:init-keyword #:padding)) +(define-method (display (x ) out) + "Pretty-print instances" + (let* ((artists (get-frames x 'artist-frame)) + (artist + (if (= 0 (length artists)) "" (slot-ref (car artists) 'text))) + (titles (get-frames x 'title-frame)) + (title (if (= 0 (length titles)) "" (slot-ref (car titles) 'text)))) + (display "" out))) + (define (has-frame-internal frms f) (cond ((null? frms) #f) ((let ((x (car frms))) (eq? f (slot-ref x 'id))) #t) @@ -245,4 +263,3 @@ at `root'" (set! frms (cdr frms))) ret)) - diff --git a/test/Makefile.am b/test/Makefile.am index 332370c..b145bf1 100644 --- a/test/Makefile.am +++ b/test/Makefile.am @@ -7,9 +7,9 @@ EXTRA_DIST = test-util test-split test-rename test-report test-report-tdf \ test-cleanup-encoded-by.scm test-cleanup-encoded-by \ test-cleanup-from-audacity.scm test-cleanup-from-audacity \ test-tagsets-from-scheme.scm test-tagsets-from-scheme \ - test-frames-from-scheme.scm test-frames-from-scheme \ + test-frames-from-scheme.scm test-display.scm test-frames-from-scheme \ test-scripting test-options test-popm test-xtag test-text test-genre \ - test-m3u test-snarfed-in-scribbu + test-m3u test-snarfed-in-scribbu test-display CLEANFILES = id3v20B id3v21B report.last.csv report-tdf.last.tdf \ report.csv report-last.csv report-tdf.tdf \ id3v20A trackB id3v1A trackA \ @@ -37,7 +37,7 @@ TESTS = $(check_PROGRAMS) test-split test-rename test-report test-report-tdf \ test-cleanup-encoded-by test-cleanup-from-audacity \ test-tagsets-from-scheme test-frames-from-scheme test-scripting \ test-options test-popm test-xtag test-text test-genre test-m3u \ - test-snarfed-in-scribbu + test-snarfed-in-scribbu test-display unit_SOURCES = unit.cc unit.hh charsets.cc ostream.cc id3v1.cc framesv2.cc \ framesv22.cc framesv23.cc framesv24.cc id3v2.cc id3v22.cc id3v23.cc \ id3v24.cc id3v2-utils.cc pprinter.cc csv-pprinter.cc mp3.cc tdf-pprinter.cc \ diff --git a/test/test-cleanup-encoded-by.scm b/test/test-cleanup-encoded-by.scm index f1db0c3..3fef155 100755 --- a/test/test-cleanup-encoded-by.scm +++ b/test/test-cleanup-encoded-by.scm @@ -35,8 +35,8 @@ This function is for testing & debugging purposes. It will simply print the trac path, the ID3v1 comment (if any) and the ID3v2 TENC frame (if any)." (format #t "~s: " pth) (if (null? v1) - (display "") - (format #t "ID3v1 comment: ~s" (slot-ref v1 'comment))) + (display " ") + (format #t "ID3v1 comment: ~s " (slot-ref v1 'comment))) (while (not (null? tags)) (let ((tag (caar tags))) (format #t "tag ~a" tag) diff --git a/test/test-display b/test/test-display new file mode 100755 index 0000000..5300067 --- /dev/null +++ b/test/test-display @@ -0,0 +1,22 @@ +#!/usr/bin/env bash +export GUILE_AUTO_COMPILE=0 + +eval "$(../src/scribbu -L ${srcdir}/../scheme -s ${srcdir}/test-display.scm ${srcdir} \ + 2> >(t_err=$(cat); typeset -p t_err) \ + > >(t_std=$(cat); typeset -p t_std) )" +t_stat=$? +# echo "$t_std" +t_err=$(echo "$t_err" | grep -vE ';;; note: source file .*test-display.scm' | grep -v ';;; note: source file .*scribbu.scm' | grep -v 'newer than compiled') +if [ ! -z "$t_err" ]; then + printf '=%.0s' $(seq 1 $cols) + echo "$t_err" + printf '=%.0s' $(seq 1 $cols) + exit 1 +fi + +output=$(echo $t_std|tr \\n :) +if [ "$output" != " :" ]; then + echo $output + exit 1 +fi + diff --git a/test/test-display.scm b/test/test-display.scm new file mode 100644 index 0000000..c332554 --- /dev/null +++ b/test/test-display.scm @@ -0,0 +1,42 @@ +;;;; test-display.scm +;;;; +;;;; Copyright (C) 2023 Michael Herstine +;;;; +;;;; This file is part of scribbu. +;;;; +;;;; scribbu is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; scribbu is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with scribbu. If not, see .;;;; +;;;; +;;;; + + +(use-modules (scribbu)) +(use-modules (oop goops)) + +(setlocale LC_ALL "en_US.UTF-8") + + +(define (main srcdir) + "Exercise pretty-printing tags." + (let ((tag (read-id3v1-tag (format #f "~a/data/elliot-goldenthal.id3v1.tag" srcdir)))) + (format (current-output-port) "~a\n" tag)) + (let ((tag (caar (read-tagset (format #f "~a/data/lorca.mp3" srcdir))))) + (format (current-output-port) "~a\n" tag))) + + +(let ((cl (cdr (command-line)))) + (if (= 1 (length cl)) + (main (car cl)) + (begin + (format #t "Usage: test-display.scm ${srcdir}\n") + (exit 2))))