tests/test-basic.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:    test-basic.lisp
   6 ;;;; Purpose: Tests for clsql-base and result types
   7 ;;;; Author:  Kevin M. Rosenberg
   8 ;;;; Created: Mar 2002
   9 ;;;;
  10 ;;;; $Id: tests.lisp 8926 2004-04-10 21:12:52Z kevin $
  11 ;;;;
  12 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; CLSQL users are granted the rights to distribute and use this software
  15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  17 ;;;; *************************************************************************
  18
  19 (in-package #:clsql-tests)
  20
  21 (defun test-basic-initialize ()
  22   (ignore-errors
  23    (clsql:execute-command "DROP TABLE TYPE_TABLE"))
  24   (clsql:execute-command
  25    "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_bigint BIGINT, t_str VARCHAR(30))")
  26   (dotimes (i 11)
  27     (let* ((test-int (- i 5))
  28            (test-flt (transform-float-1 test-int)))
  29       (clsql:execute-command
  30        (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,~a,'~a')"
  31                test-int
  32                (clsql-base:number-to-sql-string test-flt)
  33                (transform-bigint-1 test-int)
  34                (clsql-base:number-to-sql-string test-flt)
  35                )))))
  36
  37 (defun test-basic-forms ()
  38   (append
  39    (test-basic-forms-untyped)
  40    '(
  41      (deftest BASIC/TYPE/1
  42         (let ((results '()))
  43           (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
  44                     results)
  45             (destructuring-bind (int float bigint str) row
  46               (push (list (integerp int)
  47                           (typep float 'double-float)
  48                           (integerp bigint)
  49                           (stringp str))
  50                     results))))
  51       ((t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t)))
  52
  53
  54      (deftest BASIC/TYPE/2
  55          (let ((results '()))
  56            (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
  57                      results)
  58              (destructuring-bind (int float bigint str) row
  59                (push (list (double-float-equal
  60                             (transform-float-1 int)
  61                             float)
  62                            (double-float-equal
  63                             (parse-double str)
  64                             float))
  65                      results))))
  66        ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
  67      )))
  68
  69 (defun test-basic-forms-untyped ()
  70   '((deftest BASIC/SELECT/1
  71         (let ((rows (query "select * from TYPE_TABLE" :result-types :auto)))
  72           (values
  73            (length rows)
  74            (length (car rows))))
  75       11 4)
  76
  77     (deftest BASIC/SELECT/2
  78         (let ((results '()))
  79           (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
  80                     results)
  81             (destructuring-bind (int float bigint str) row
  82               (push (list (stringp int)
  83                           (stringp float)
  84                           (stringp bigint)
  85                           (stringp str))
  86                     results))))
  87       ((t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t)))
  88
  89     (deftest BASIC/SELECT/3
  90         (let ((results '()))
  91           (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
  92                     results)
  93             (destructuring-bind (int float bigint str) row
  94               (push (list (double-float-equal
  95                            (transform-float-1 (parse-integer int))
  96                            (parse-double float))
  97                           (double-float-equal
  98                            (parse-double str)
  99                            (parse-double float)))
 100                     results))))
 101       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 102
 103     (deftest BASIC/MAP/1
 104         (let ((results '())
 105               (rows (map-query 'vector #'list "select * from TYPE_TABLE"
 106                                :result-types nil)))
 107           (dotimes (i (length rows) results)
 108             (push
 109              (list
 110               (listp (aref rows i))
 111               (length (aref rows i))
 112               (eql (- i 5)
 113                    (parse-integer (first (aref rows i))
 114                                   :junk-allowed nil))
 115               (double-float-equal
 116                (transform-float-1 (parse-integer (first (aref rows i))))
 117                (parse-double (second (aref rows i)))))
 118              results)))
 119       ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t)))
 120
 121     (deftest BASIC/MAP/2
 122         (let ((results '())
 123               (rows (map-query 'list #'list "select * from TYPE_TABLE"
 124                                :result-types nil)))
 125           (dotimes (i (length rows) results)
 126             (push
 127              (list
 128               (listp (nth i rows))
 129               (length (nth i rows))
 130               (eql (- i 5)
 131                    (parse-integer (first (nth i rows))
 132                                   :junk-allowed nil))
 133               (double-float-equal
 134                (transform-float-1 (parse-integer (first (nth i rows))))
 135                (parse-double (second (nth i rows)))))
 136              results)))
 137       ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t)))
 138
 139     (deftest BASIC/DO/1
 140         (let ((results '()))
 141           (do-query ((int float bigint str) "select * from TYPE_TABLE")
 142             (push (list (double-float-equal
 143                          (transform-float-1 (parse-integer int))
 144                          (parse-double float))
 145                         (double-float-equal
 146                          (parse-double str)
 147                          (parse-double float)))
 148                   results))
 149           results)
 150       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 151     ))
 152
 153
 154 ;;;; Testing functions
 155
 156 (defun transform-float-1 (i)
 157   (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
 158
 159 (defun transform-bigint-1 (i)
 160   (* i (expt 10 (* 3 (abs i)))))
 161
 162 (defun parse-double (num-str)
 163   (let ((*read-default-float-format* 'double-float))
 164     (coerce (read-from-string num-str) 'double-float)))
 165
 166 (defun double-float-equal (a b)
 167   (if (zerop a)
 168       (if (zerop b)
 169           t
 170           nil)
 171       (let ((diff (abs (/ (- a b) a))))
 172         (if (> diff (* 10 double-float-epsilon))
 173             nil
 174             t))))