1
0
mirror of synced 2026-05-04 07:09:35 +00:00
Files
Interlisp.medley/internal/test/LANGUAGE/AUTO/FLOATP.TEST

131 lines
3.9 KiB
Plaintext

;; Function To Be Tested: FLOATP
;;
;; Source: IRM, p 9.1
;;
;; Chapter 9: Conditionals And Iterative Statements
;; Section 1: Data Type Predicates
;;
;; Created By: Henry Cate III
;;
;; Creation Date: March 11, 1987
;;
;; Last Update:
;;
;; Filed As: {eris}<lispcore>test>DataTypes>FloarP.test
;;
;;
(do-test "test simple cases"
(and
(equal 5.9 (il:floatp 5.9))
(equal -10.13 (il:floatp -10.13))
(eq nil (il:floatp -5))
(eq nil (il:floatp 1000000))
(eq nil (il:floatp 'a-floatp))
(eq nil (il:floatp "a string"))
))
(do-test "Test floating numbers"
(and
(equal 123.0 (il:floatp 123.0))
(equal 45.67 (il:floatp 45.67))
(equal 37e5 (il:floatp 37e5))
(equal .001 (il:floatp .001))
))
(do-test "Test go on own function"
(flet ((temp-small nil -1.2)
(temp-large nil 100000.01)
(temp-floating nil 12.2))
(test-defun temp-fun nil 32e5)
(and
(equal -1.2 (il:floatp (temp-small)))
(equal 100000.01 (il:floatp (temp-large)))
(equal 12.2 (il:floatp (temp-floating)))
(equal 32e5 (il:floatp (temp-fun)))
)))
(do-test "Test work against system functions"
(and
(equal 1.2 (il:floatp (third '(1 2 1.2 4 5))))
(equal -3.3 (il:floatp (car '(-3.3 2.2 1.1))))
(equal 10101012.3 (il:floatp (second '(1 10101012.3 4.5 6))))
))
(do-test "Try various types of Litatoms"
(and
(eq nil (il:floatp 'ABCDEFGHIJKLMNOPQRSTUVWXYZ))
(eq nil (il:floatp 'A-couple-dashs))
(eq nil (il:floatp 'Numbers-1234567890))
(eq nil (il:floatp 'il:other-packags))
(eq nil (il:floatp 'il:other-packagsNumbers-1234567890))
(eq nil (il:floatp 'il:other-packagsA-couple-dashs))
(eq nil (il:floatp T))
(eq nil (il:floatp nil))
(eq nil (il:floatp ()))
(eq nil (il:floatp '()))
(eq nil (il:floatp (list)))
(eq nil (il:floatp (eq 1 2)))
))
(do-test "Test stop on own function"
(flet ((tee nil t) (nill nil nil) (temp-litatom nil 'litatom)
(temp-string nil "string"))
(test-defun temp-fun nil 'litatom)
(test-setq temp-litatom 'il:temp-pointed)
(and
(eq nil (il:floatp (tee)))
(eq nil (il:floatp (nill)))
(eq nil (il:floatp (temp-litatom)))
(eq nil (il:floatp (temp-string)))
(eq nil (il:floatp (temp-fun)))
(eq nil (il:floatp temp-litatom))
)))
(do-test "Stop on floatps from system functions"
(and
(eq nil (il:floatp (car '(#*1001 '#( 5 4 3 2 1)))))
(eq nil (il:floatp (second '(#\. #\k))))
))
(do-test "Test arrays aren't floatps"
(and
(eq nil (il:floatp (make-array '(2 2))))
(eq nil (il:floatp (make-array '(6 6 6) :element-type '(or integer string))))
(eq nil (il:floatp (make-array 5 :element-type 'bit :initial-contents '(0 0 1 1 0))))
(eq nil (il:floatp (make-array '(5 5) :displaced-to (make-array '(6 6 6) :element-type '(or integer string)))))
(eq nil (il:floatp (make-array 50 :initial-element 0)))
(eq nil (il:floatp (make-array 20 :element-type 'string-char :initial-element #\0)))
))
(do-test "Test other datatypes aren't floatps"
(and
(eq nil (il:floatp #\backspace)) ; character
(eq nil (il:floatp #\*)) ; character
(eq nil (il:floatp #\.)) ; character
(eq nil (il:floatp (make-hash-table))) ; hash table
(eq nil (il:floatp (car (list-all-packages)))) ; packages
(eq nil (il:floatp (pathname nil))) ; pathname
(eq nil (il:floatp *random-state*)) ; ramdom state
(eq nil (il:floatp #'cons)) ; compiled function
(eq nil (il:floatp (copy-readtable))) ; readtable
(eq nil (il:floatp #*1001)) ; simple-bit-vector
(eq nil (il:floatp "twine")) ; simple-string
(eq nil (il:floatp (make-synonym-stream nil))) ; stream
(eq nil (il:floatp '#( 5 4 3 2 1))) ; vector
))
STOP