;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:     test-ooddl.lisp
;;;; Purpose:  Tests for the CLSQL Object Oriented Data Definition Language
;;;; Authors:  Marcus Pearce and Kevin M. Rosenberg
;;;; Created:  March 2004
;;;;
;;;; This file is part of CLSQL.
;;;;
;;;; CLSQL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************


(in-package #:clsql-tests)

(clsql-sys:file-enable-sql-reader-syntax)


(def-view-class big ()
  ((i :type integer :initarg :i)
   (bi :type bigint :initarg :bi)))

(def-dataset *ds-big*
  (:setup (lambda ()
	    (clsql-sys:create-view-from-class 'big)
	    (let ((max (expt 2 60)))
	      (dotimes (i 555)
		(update-records-from-instance
		 (make-instance 'big :i (1+ i) :bi (truncate max (1+ i))))))))
  (:cleanup
   (lambda ()  (clsql-sys:drop-view-from-class 'big))))

(setq *rt-ooddl*
      '(

;; Ensure slots inherited from standard-classes are :virtual
(deftest :ooddl/metaclass/1
    (values
     (clsql-sys::view-class-slot-db-kind
      (clsql-sys::slotdef-for-slot-with-class 'extraterrestrial
                                             (find-class 'person)))
     (clsql-sys::view-class-slot-db-kind
      (clsql-sys::slotdef-for-slot-with-class 'hobby (find-class 'person))))
  :virtual :virtual)

;; Ensure all slots in view-class are view-class-effective-slot-definition
(deftest :ooddl/metaclass/2
    (values
     (every #'(lambda (slotd)
                (typep slotd 'clsql-sys::view-class-effective-slot-definition))
            (clsql-sys::class-slots (find-class 'person)))
     (every #'(lambda (slotd)
                (typep slotd 'clsql-sys::view-class-effective-slot-definition))
            (clsql-sys::class-slots (find-class 'employee)))
     (every #'(lambda (slotd)
                (typep slotd 'clsql-sys::view-class-effective-slot-definition))
            (clsql-sys::class-slots (find-class 'setting)))
     (every #'(lambda (slotd)
                (typep slotd 'clsql-sys::view-class-effective-slot-definition))
            (clsql-sys::class-slots (find-class 'theme)))
     (every #'(lambda (slotd)
                (typep slotd 'clsql-sys::view-class-effective-slot-definition))
            (clsql-sys::class-slots (find-class 'node)))
     (every #'(lambda (slotd)
                (typep slotd 'clsql-sys::view-class-effective-slot-definition))
            (clsql-sys::class-slots (find-class 'company))))
  t t t t t t)

;; Ensure classes are correctly marked normalized or not, default not
;(deftest :ooddl/metaclass/3
;    (values
;     (clsql-sys::normalizedp derivednode1)
;    (clsql-sys::normalizedp basenode)
;    (clsql-sys::normalizedp company1)
;    (clsql-sys::normalizedp employee3)
;    (clsql-sys::normalizedp derivednode-sc-2))
;  t nil nil nil t)

;(deftest :ooddl/metaclass/3
; (values
;  (normalizedp (find-class 'baseclass))
;  (normalizedp (find-class 'normderivedclass)))
; nil t)

(deftest :ooddl/join/1
    (with-dataset *ds-employees*
      (mapcar #'(lambda (e) (slot-value e 'ecompanyid))
	      (company-employees company1)))
  (1 1 1 1 1 1 1 1 1 1))

(deftest :ooddl/join/2
    (with-dataset *ds-employees*
      (slot-value (president company1) 'last-name))
  "Lenin")

(deftest :ooddl/join/3
    (with-dataset *ds-employees*
      (slot-value (employee-manager employee2) 'last-name))
  "Lenin")

(deftest :ooddl/join/4
    (with-dataset *ds-employees*
      (values
       (length (employee-addresses employee10))
       ;; add an address
       (let ((*db-auto-sync* T))
         (make-instance 'address :addressid 50)
         (make-instance 'employee-address :emplid 10 :addressid 50)
         ;; again
         (length (employee-addresses employee10)))
       (progn
         (update-objects-joins (list employee10) :slots '(addresses))
         (length (employee-addresses employee10)))))
  0 0 1)

(deftest :ooddl/big/1
    ;;tests that we can create-view-from-class with a bigint slot,
    ;; and stick a value in there.
    (progn (clsql-sys:create-view-from-class 'big)
	   (values
	     (clsql:table-exists-p [big] )
	     (progn
	       (clsql:drop-table [big] :if-does-not-exist :ignore)
	       (clsql:table-exists-p [big] )))
	   )
  t nil)

(deftest :ooddl/big/2
    (with-dataset *ds-big*
      (let ((rows (clsql:select [*] :from [big] :order-by [i] :field-names nil)))
	(values
	  (length rows)
	  (do ((i 0 (1+ i))
	       (max (expt 2 60))
	       (rest rows (cdr rest)))
	      ((= i (length rows)) t)
	    (let ((index (1+ i))
		  (int (first (car rest)))
		  (bigint (second (car rest))))
	      (when (and (or (eq *test-database-type* :oracle)
			     (and (eq *test-database-type* :odbc)
				  (eq *test-database-underlying-type* :postgresql)))
			 (stringp bigint))
		(setf bigint (parse-integer bigint)))
	      (unless (and (eql int index)
			   (eql bigint (truncate max index)))
		(return nil)))))))
  555 t)

(deftest :ooddl/time/1
    (with-dataset *ds-employees*
      (sleep 1) ;force birthdays into the past
      (let* ((now (clsql:get-time)))
	(when (member *test-database-underlying-type* '(:postgresql :postgresql-socket))
	  (clsql:execute-command "set datestyle to 'iso'"))
	(clsql:update-records [employee] :av-pairs `((birthday ,now))
			      :where [= [emplid] 1])
	(let ((dbobj (car (clsql:select 'employee :where [= [birthday] now]
					:flatp t))))
	  (values
	    (slot-value dbobj 'last-name)
	    (clsql:time= (slot-value dbobj 'birthday) now)))))
  "Lenin" t)

(deftest :ooddl/time/2
    (with-dataset *ds-employees*
      (sleep 1) ;force birthdays into the past
      (let* ((now (clsql:get-time))
	     (fail-index -1))
	(when (member *test-database-underlying-type* '(:postgresql :postgresql-socket))
	  (clsql:execute-command "set datestyle to 'iso'"))
	(dotimes (x 40)
	  (clsql:update-records [employee] :av-pairs `((birthday ,now))
				:where [= [emplid] 1])
	  (let ((dbobj (car (clsql:select 'employee :where [= [birthday] now]
					  :flatp t))))
	    (unless (clsql:time= (slot-value dbobj 'birthday) now)
	      (setf fail-index x))
	    (setf now (clsql:roll now :day (* 10 x)))))
	fail-index))
  -1)

(deftest :ooddl/time/3
    (with-dataset *ds-employees*
      (progn
	(when (member *test-database-underlying-type* '(:postgresql :postgresql-socket))
	  (clsql:execute-command "set datestyle to 'iso'"))
	(let ((dbobj (car (clsql:select 'employee :where [= [emplid] 10]
					:flatp t))))
	  (list
	   (eql *test-start-utime* (slot-value dbobj 'bd-utime))
	   (clsql:time= (slot-value dbobj 'birthday)
			(clsql:utime->time (slot-value dbobj 'bd-utime)))))))
  (t t))

))


