changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/q/tests/suite.lisp

changeset 582: 568c39371122
parent: 571685ae64f1
child: 35bb0d5ec95e
author: Richard Westhaver <ellis@rwest.io>
date: Wed, 07 Aug 2024 21:09:43 -0400
permissions: -rw-r--r--
description: sql updates, fuzzz 
     1 ;;; tests.lisp --- Q Tests
     2 
     3 ;; 
     4 
     5 ;;; Code:
     6 (in-package :q/tests)
     7 
     8 (defsuite :q)
     9 
    10 (in-suite :q)
    11 
    12 (deftest sanity ()
    13   (is (make-instance 'query-engine
    14         :parser (make-instance 'query-parser)
    15         :optimizer (make-instance 'sql-optimizer)
    16         :sources nil)))
    17 
    18 (deftest sql-select ()
    19   (setf (gethash "FOO" tbl) (make-df nil))
    20   (with-sql (expr "SELECT I FROM FOO")
    21     (is (typep expr 'sql-select))
    22     (let ((tbl (make-hash-table :test 'equalp)))
    23       (is (gethash "FOO" tbl))
    24       (make-sql-data-frame expr tbl))))
    25 
    26 (deftest sql-math ()
    27   (with-sql (expr "1 + 2 * 3")
    28     (is (typep expr 'sql-math-expression))
    29     (is (typep (rhs expr) 'sql-math-expression))
    30     (is (typep (lhs expr) 'sql-number))))
    31 
    32 ;; https://www.cpp.edu/~jrfisher/www/prolog_tutorial/2_1.html
    33 (deftest dql (:skip t)
    34   (adjacent 1 2)
    35   (adjacent 2 1) 
    36   (adjacent 1 3)
    37   (adjacent 3 1) 
    38   (adjacent 1 4)
    39   (adjacent 4 1) 
    40   (adjacent 1 5)
    41   (adjacent 5 1) 
    42   (adjacent 2 3)
    43   (adjacent 3 2) 
    44   (adjacent 2 4)
    45   (adjacent 4 2) 
    46   (adjacent 3 4)
    47   (adjacent 4 3) 
    48   (adjacent 4 5)
    49   (adjacent 5 4) 
    50   (color 1 red a)    (color 1 red b) 
    51   (color 2 blue a)   (color 2 blue b) 
    52   (color 3 green a)  (color 3 green b) 
    53   (color 4 yellow a) (color 4 blue b) 
    54   (color 5 blue a)   (color 5 green b)
    55 
    56   (:- (conflict ?coloring)
    57       (adjacent ?x ?y)  
    58       (color ?x ?color ?coloring)  
    59       (color ?y ?color ?coloring))
    60 
    61 
    62   (:- (conflict ?r1 ?r2 ?coloring)
    63       (adjacent ?r1 ?r2)  
    64       (color ?r1 ?color ?coloring)  
    65       (color ?r2 ?color ?coloring))
    66 
    67 
    68   ;; there are several infix operators.
    69   ;; :- , >, <, -> etc.
    70   ;; let's mark variables with ? prefix.
    71   ;; 
    72 
    73   (:- main
    74       (forall (conflict ?coloring)
    75               (writeln (conflict ?coloring)))
    76       (forall (conflict ?r1 ?r2 ?coloring)
    77               (writeln (conflict ?r1 ?r2 ?coloring)))
    78       (forall (conflict ?r1 ?r2 ?coloring)
    79               (and (print-sexp (conflict ?r1 ?r2 ?coloring))
    80                    nl))
    81       halt)
    82 
    83   (:- (initialization main)))