tests to make sure that e.g. cf4 doesn't end up as b3 (i.e. retains i…

…ts flat) and check is-flat et al are passed note symbols
mdedwards · Oct 21, 2024 · 29732d1 · 29732d1
1 parent 94c69e9
commit 29732d1
Show file tree

Hide file tree

Showing 2 changed files with 47 additions and 30 deletions.
diff --git a/src/cm.lsp b/src/cm.lsp
@@ -19,7 +19,7 @@
 ;;;
 ;;; Creation date:    1st March 2001
 ;;;
-;;; $$ Last modified:  14:50:54 Sat Oct 19 2024 CEST
+;;; $$ Last modified:  08:14:50 Mon Oct 21 2024 CEST
 ;;;
 ;;; SVN ID: $Id$
 ;;;
@@ -641,52 +641,62 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defun is-qtr-flat (note)
- (search "QF" (string (cm::note (rm-package note :cm)))))
+  ;; MDE Mon Oct 21 08:14:44 2024, Heidhausen -- different logic: see below
+  (when (cm::note note)
+    (search "QF" (string note)))) ;(cm::note (rm-package note :cm)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defun is-qtr-sharp (note)
-  (search "QS" (string (cm::note (rm-package note :cm)))))
+  (when (cm::note note)
+    (search "QS" (string note )))) ;(cm::note (rm-package note :cm)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defun is-sharp (note)
-  ;; MDE Sat Oct 19 14:50:29 2024, Heidhausen -- no need for cm note
-  (let ((str (string note))) ;(cm::note (rm-package note :cm)))))
-    (and (equal #\S (elt str 1))
-               ;; (digit-char-p (elt str 2)))
-               ;; MDE Sun Dec 29 14:19:55 2013 -- got to take octave -1 into
-               ;; account!  
-               (integer-as-string str 2))))
+  ;; MDE Sat Oct 19 14:50:29 2024, Heidhausen -- no need for cm note in the
+  ;; string
+  (when (cm::note note)
+    (let ((str (string note)))          ;(cm::note (rm-package note :cm)))))
+      (and (equal #\S (elt str 1))
+           ;; (digit-char-p (elt str 2)))
+           ;; MDE Sun Dec 29 14:19:55 2013 -- got to take octave -1 into
+           ;; account!  
+           (integer-as-string str 2)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defun is-flat (note)
-  ;; MDE Sat Oct 19 14:47:43 2024, Heidhausen -- not need to use the cm fun
-  (let ((str (string note)))            ;(cm::note (rm-package note :cm)))))
-    ;; (print str)
-    (and (equal #\F (elt str 1))
-         ;; (digit-char-p (elt str 2)))
-         ;; MDE Sun Dec 29 14:19:55 2013 -- got to take octave -1 into
-         ;; account!  
-         (integer-as-string str 2))))
+  ;; MDE Sat Oct 19 14:47:43 2024, Heidhausen -- not need to use the cm fun for
+  ;; making the string--problematic as e.g. es4 is turned into f4 so (sharp ) is
+  ;; nil when turned into a pitch--as before but good to check that we've been
+  ;; passed an actual note symbol
+  (when (cm::note note)
+    (let ((str (string note)))            
+      ;; (print str)
+      (and (equal #\F (elt str 1))
+           ;; (digit-char-p (elt str 2)))
+           ;; MDE Sun Dec 29 14:19:55 2013 -- got to take octave -1 into
+           ;; account!  
+           (integer-as-string str 2)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;;; N.B. won't work with bracketed accidentals of the form cbn3!
 
 (defun is-natural (note)
-  (let* ((string (string note))
-         2nd-char)
-    (when (> (length string) 1)
-      (setf 2nd-char (elt string 1))
-      ;; MDE Sun Dec 29 14:19:55 2013 -- got to take octave -1 into
-      ;; account!  
-      ;; (or (numberp (digit-char-p 2nd-char))
-      ;;    (equal 2nd-char #\N)))))
-      (or (integer-as-string string 1)
-          (and (equal 2nd-char #\N)
-               (integer-as-string string 2))))))
+  (when (cm::note note)
+    (let* ((string (string note))
+           2nd-char)
+      (when (> (length string) 1)
+        (setf 2nd-char (elt string 1))
+        ;; MDE Sun Dec 29 14:19:55 2013 -- got to take octave -1 into
+        ;; account!  
+        ;; (or (numberp (digit-char-p 2nd-char))
+        ;;    (equal 2nd-char #\N)))))
+        (or (integer-as-string string 1)
+            (and (equal 2nd-char #\N)
+                 (integer-as-string string 2)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

diff --git a/tests/sc-test-suite.lsp b/tests/sc-test-suite.lsp
@@ -17,7 +17,7 @@
 ;;;
 ;;; Creation date:    7th December 2011 (Edinburgh)
 ;;;
-;;; $$ Last modified:  14:48:46 Sat Oct 19 2024 CEST
+;;; $$ Last modified:  08:11:18 Mon Oct 21 2024 CEST
 ;;;
 ;;; SVN ID: $Id: sc-test-suite.lsp 6249 2017-06-07 16:05:15Z medward2 $
 ;;;
@@ -3273,6 +3273,13 @@
   (let ((p1 (make-pitch 'c4))
         (p2 (make-pitch 261.63 :src-ref-pitch 'a4 :midi-channel 1)))
     (sc-test-check
+      ;; MDE Mon Oct 21 08:02:39 2024, Heidhausen -- the cm fun first then check
+      ;; that enharmonic-equivalents are not produced for b# and c-flat 
+      (is-flat 'cf3)
+      (is-sharp 'es9)
+      (is-natural 'f5)
+      (sharp (make-pitch 'bs4))
+      (flat (make-pitch 'ff1))
       ;; p1
       (pitch-p p1)
       (= (frequency p1) (note-to-freq 'c4))