Ihor Radchenko <[email protected]> writes:
> Morgan Smith <[email protected]> writes:
>
>> Subject: [PATCH 11/13] Testing: Suppress suspicious eq warning
>>
>> * testing/lisp/test-org-element.el (test-org-element/copy): Suppress
>> suspicious eq warning
>> ---
>> testing/lisp/test-org-element.el | 4 +++-
>> 1 file changed, 3 insertions(+), 1 deletion(-)
>>
>> diff --git a/testing/lisp/test-org-element.el
>> b/testing/lisp/test-org-element.el
>> index c082339c7..ecfa63a91 100644
>> --- a/testing/lisp/test-org-element.el
>> +++ b/testing/lisp/test-org-element.el
>> @@ -811,7 +811,9 @@ test-org-element/copy
>> (should-not (org-element-copy nil))
>> ;; Return a copy secondary strings.
>> (should (equal '("text") (org-element-copy '("text"))))
>> - (should-not (eq '("text") (org-element-copy '("text"))))
>> + (with-suppressed-warnings ((suspicious eq))
>> + (should-not
>> + (eq '("text") (org-element-copy '("text")))))
>> ;; Do not alter the source.
>> (org-test-with-temp-text "*bold*"
>> (let* ((source (org-element-context))
>
> This looks like a valid warning. Can change to equal I think.
We do use equal in the line right above my changes. This test is
ensuring the string gets copied. So it makes sure the strings are
"equal" but not "eq".
>> Subject: [PATCH 03/13] Testing: Use advice to override time functions
>>
>> When including files that have been compiled that run this macro one
>> would sometimes get the error "Invalid read syntax #<".
>>
>> By using advice things seem to work without error now.
>>
>> * testing/org-test.el (org-test-at-time): Advise time functions with
>> `add-function' instead of directly setting the functions with
>> `cl-letf'.
>
> This looks clunky. I suspect that invalid read syntax errors might be
> originating from ,at instances when AT is a string with properties that
> contain some metadata that includes unreadable objects like buffers.
> If my suspicion is correct, as simpler way to avoid runtime errors is
> simply stripping AT from text properties. They are not needed anyway.
Unfortunately, it's not that simple. The error stems from the
",(symbol-function 'current-time-string)" part which emits bytecode that
includes "#<subr current-time-string>". I don't think we are supposed
to use raw references to C source code functions in our code. By
applying the diff shown below, the errors go away even though the
references to ",at" remain the same. The included diff stores all the
original functions in a dedicated obarray.
#+begin_src diff
@@ -504,51 +512,70 @@ org-test-at-time
`(let* ((,tm ,time)
(,at (if (stringp ,tm)
(org-time-string-to-time ,tm)
- ,tm)))
+ ,tm))
+ (org-test-obarray (obarray-make))
+ (get-original-function (lambda (func) (symbol-function
+ (obarray-get
+ org-test-obarray
+ func)))))
+ (mapc
+ (lambda (symbol)
+ (fset (intern (symbol-name symbol) org-test-obarray)
(symbol-function symbol)))
+ '(current-time-string
+ current-time-zone
+ decode-time
+ encode-time
+ float-time
+ format-time-string
+ set-file-times
+ time-add
+ time-equal-p
+ time-less-p
+ time-subtract))
(cl-letf
;; Wrap builtins whose behavior can depend on the current time.
(((symbol-function 'current-time)
(lambda () ,at))
((symbol-function 'current-time-string)
(lambda (&optional time &rest args)
- (apply ,(symbol-function 'current-time-string)
+ (apply (funcall get-original-function "current-time-string")
(or time ,at) args)))
((symbol-function 'current-time-zone)
(lambda (&optional time &rest args)
- (apply ,(symbol-function 'current-time-zone)
+ (apply (funcall get-original-function "current-time-zone")
(or time ,at) args)))
((symbol-function 'decode-time)
(lambda (&optional time zone form)
(condition-case nil
- (funcall ,(symbol-function 'decode-time)
+ (funcall (funcall get-original-function "decode-time")
(or time ,at) zone form)
(wrong-number-of-arguments
- (funcall ,(symbol-function 'decode-time)
+ (funcall (funcall get-original-function "decode-time")
(or time ,at))))))
((symbol-function 'encode-time)
(lambda (time &rest args)
- (apply ,(symbol-function 'encode-time) (or time ,at) args)))
+ (apply (funcall get-original-function "encode-time") (or time
,at) args)))
((symbol-function 'float-time)
(lambda (&optional time)
- (funcall ,(symbol-function 'float-time) (or time ,at))))
+ (funcall (funcall get-original-function "float-time") (or time
,at))))
((symbol-function 'format-time-string)
(lambda (format &optional time &rest args)
- (apply ,(symbol-function 'format-time-string)
+ (apply (funcall get-original-function "format-time-string")
format (or time ,at) args)))
((symbol-function 'set-file-times)
(lambda (file &optional time)
- (funcall ,(symbol-function 'set-file-times) file (or time ,at))))
+ (funcall (funcall get-original-function "set-file-times") file
(or time ,at))))
((symbol-function 'time-add)
- (lambda (a b) (funcall ,(symbol-function 'time-add)
- (or a ,at) (or b ,at))))
+ (lambda (a b) (funcall (funcall get-original-function "time-add")
+ (or a ,at) (or b ,at))))
((symbol-function 'time-equal-p)
- (lambda (a b) (funcall ,(symbol-function 'time-equal-p)
+ (lambda (a b) (funcall (funcall get-original-function
"time-equal-p")
(or a ,at) (or b ,at))))
((symbol-function 'time-less-p)
- (lambda (a b) (funcall ,(symbol-function 'time-less-p)
+ (lambda (a b) (funcall (funcall get-original-function
"time-less-p")
(or a ,at) (or b ,at))))
((symbol-function 'time-subtract)
- (lambda (a b) (funcall ,(symbol-function 'time-subtract)
+ (lambda (a b) (funcall (funcall get-original-function
"time-subtract")
(or a ,at) (or b ,at)))))
,@body))))
#+end_src
