basis/db/tuples/tuples-tests.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: io.files kernel tools.test db db.tuples classes
   4 db.types continuations namespaces math math.ranges
   5 prettyprint calendar sequences db.sqlite math.intervals
   6 db.postgresql accessors random math.bitwise
   7 math.ranges strings urls fry db.tuples.private ;
   8 IN: db.tuples.tests
   9
  10 : sqlite-db ( -- sqlite-db )
  11     "tuples-test.db" temp-file <sqlite-db> ;
  12
  13 : test-sqlite ( quot -- )
  14     '[
  15         [ ] [
  16             "tuples-test.db" temp-file <sqlite-db> _ with-db
  17         ] unit-test
  18     ] call ; inline
  19
  20 : postgresql-db ( -- postgresql-db )
  21     <postgresql-db>
  22         "localhost" >>host
  23         "postgres" >>username
  24         "thepasswordistrust" >>password
  25         "factor-test" >>database ;
  26
  27 : test-postgresql ( quot -- )
  28     '[
  29         [ ] [ postgresql-db _ with-db ] unit-test
  30     ] call ; inline
  31
  32 ! These words leak resources, but are useful for interactivel testing
  33 : sqlite-test-db ( -- )
  34     sqlite-db db-open db set ;
  35
  36 : postgresql-test-db ( -- )
  37     postgresql-db db-open db set ;
  38
  39 TUPLE: person the-id the-name the-number the-real
  40 ts date time blob factor-blob url ;
  41
  42 : <person> ( name age real ts date time blob factor-blob url -- person )
  43     person new
  44         swap >>url
  45         swap >>factor-blob
  46         swap >>blob
  47         swap >>time
  48         swap >>date
  49         swap >>ts
  50         swap >>the-real
  51         swap >>the-number
  52         swap >>the-name ;
  53
  54 : <user-assigned-person> ( id name age real ts date time blob factor-blob url -- person )
  55     <person>
  56         swap >>the-id ;
  57
  58 SYMBOL: person1
  59 SYMBOL: person2
  60 SYMBOL: person3
  61 SYMBOL: person4
  62
  63 : test-tuples ( -- )
  64     [ ] [ person recreate-table ] unit-test
  65     [ ] [ person ensure-table ] unit-test
  66     [ ] [ person drop-table ] unit-test
  67     [ ] [ person create-table ] unit-test
  68     [ person create-table ] must-fail
  69     [ ] [ person ensure-table ] unit-test
  70
  71     [ ] [ person1 get insert-tuple ] unit-test
  72
  73     [ 1 ] [ person1 get the-id>> ] unit-test
  74
  75     [ ] [ person1 get 200 >>the-number drop ] unit-test
  76
  77     [ ] [ person1 get update-tuple ] unit-test
  78
  79     [ T{ person f 1 "billy" 200 3.14 } ]
  80     [ T{ person f 1 } select-tuple ] unit-test
  81     [ ] [ person2 get insert-tuple ] unit-test
  82     [
  83         {
  84             T{ person f 1 "billy" 200 3.14 }
  85             T{ person f 2 "johnny" 10 3.14 }
  86         }
  87     ] [ T{ person f f f f 3.14 } select-tuples ] unit-test
  88     [
  89         {
  90             T{ person f 1 "billy" 200 3.14 }
  91             T{ person f 2 "johnny" 10 3.14 }
  92         }
  93     ] [ T{ person f } select-tuples ] unit-test
  94
  95     [
  96         {
  97             T{ person f 2 "johnny" 10 3.14 }
  98         }
  99     ] [ T{ person f f f 10 3.14 } select-tuples ] unit-test
 100
 101
 102     [ ] [ person1 get delete-tuples ] unit-test
 103     [ f ] [ T{ person f 1 } select-tuple ] unit-test
 104
 105     [ ] [ person3 get insert-tuple ] unit-test
 106
 107     [
 108         T{
 109             person
 110             f
 111             3
 112             "teddy"
 113             10
 114             3.14
 115             T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } }
 116             T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } }
 117             T{ timestamp f 0 0 0 12 34 56 T{ duration f 0 0 0 0 0 0 } }
 118             B{ 115 116 111 114 101 105 110 97 98 108 111 98 }
 119         }
 120     ] [ T{ person f 3 } select-tuple ] unit-test
 121
 122     [ ] [ person4 get insert-tuple ] unit-test
 123     [
 124         T{
 125             person
 126             f
 127             4
 128             "eddie"
 129             10
 130             3.14
 131             T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } }
 132             T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } }
 133             T{ timestamp f 0 0 0 12 34 56 T{ duration f 0 0 0 0 0 0 } }
 134             f
 135             H{ { 1 2 } { 3 4 } { 5 "lol" } }
 136             URL" http://www.google.com/search?hl=en&q=trailer+park+boys&btnG=Google+Search"
 137         }
 138     ] [ T{ person f 4 } select-tuple ] unit-test
 139
 140     [ ] [ person drop-table ] unit-test ;
 141
 142 : db-assigned-person-schema ( -- )
 143     person "PERSON"
 144     {
 145         { "the-id" "ID" +db-assigned-id+ }
 146         { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
 147         { "the-number" "AGE" INTEGER { +default+ 0 } }
 148         { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
 149         { "ts" "TS" TIMESTAMP }
 150         { "date" "D" DATE }
 151         { "time" "T" TIME }
 152         { "blob" "B" BLOB }
 153         { "factor-blob" "FB" FACTOR-BLOB }
 154         { "url" "U" URL }
 155     } define-persistent
 156     "billy" 10 3.14 f f f f f f <person> person1 set
 157     "johnny" 10 3.14 f f f f f f <person> person2 set
 158     "teddy" 10 3.14
 159         T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } }
 160         T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } }
 161         T{ timestamp f 0 0 0 12 34 56 T{ duration f 0 0 0 0 0 0 } }
 162         B{ 115 116 111 114 101 105 110 97 98 108 111 98 } f f <person> person3 set
 163     "eddie" 10 3.14
 164         T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } }
 165         T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } }
 166         T{ timestamp f 0 0 0 12 34 56 T{ duration f 0 0 0 0 0 0 } }
 167         f H{ { 1 2 } { 3 4 } { 5 "lol" } } URL" http://www.google.com/search?hl=en&q=trailer+park+boys&btnG=Google+Search"  <person> person4 set ;
 168
 169 : user-assigned-person-schema ( -- )
 170     person "PERSON"
 171     {
 172         { "the-id" "ID" INTEGER +user-assigned-id+ }
 173         { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
 174         { "the-number" "AGE" INTEGER { +default+ 0 } }
 175         { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
 176         { "ts" "TS" TIMESTAMP }
 177         { "date" "D" DATE }
 178         { "time" "T" TIME }
 179         { "blob" "B" BLOB }
 180         { "factor-blob" "FB" FACTOR-BLOB }
 181         { "url" "U" URL }
 182     } define-persistent
 183     1 "billy" 10 3.14 f f f f f f <user-assigned-person> person1 set
 184     2 "johnny" 10 3.14 f f f f f f <user-assigned-person> person2 set
 185     3 "teddy" 10 3.14
 186         T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } }
 187         T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } }
 188         T{ timestamp f 0 0 0 12 34 56 T{ duration f 0 0 0 0 0 0 } }
 189         B{ 115 116 111 114 101 105 110 97 98 108 111 98 }
 190         f f <user-assigned-person> person3 set
 191     4 "eddie" 10 3.14
 192         T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } }
 193         T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } }
 194         T{ timestamp f 0 0 0 12 34 56 T{ duration f 0 0 0 0 0 0 } }
 195         f H{ { 1 2 } { 3 4 } { 5 "lol" } } URL" http://www.google.com/search?hl=en&q=trailer+park+boys&btnG=Google+Search" <user-assigned-person> person4 set ;
 196
 197
 198 TUPLE: paste n summary author channel mode contents timestamp annotations ;
 199 TUPLE: annotation n paste-id summary author mode contents ;
 200
 201 paste "PASTE"
 202 {
 203     { "n" "ID" +db-assigned-id+ }
 204     { "summary" "SUMMARY" TEXT }
 205     { "author" "AUTHOR" TEXT }
 206     { "channel" "CHANNEL" TEXT }
 207     { "mode" "MODE" TEXT }
 208     { "contents" "CONTENTS" TEXT }
 209     { "timestamp" "DATE" TIMESTAMP }
 210     { "annotations" { +has-many+ annotation } }
 211 } define-persistent
 212
 213 : annotation-schema-foreign-key ( -- )
 214     annotation "ANNOTATION"
 215     {
 216         { "n" "ID" +db-assigned-id+ }
 217         { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "ID" } }
 218         { "summary" "SUMMARY" TEXT }
 219         { "author" "AUTHOR" TEXT }
 220         { "mode" "MODE" TEXT }
 221         { "contents" "CONTENTS" TEXT }
 222     } define-persistent ;
 223
 224 : annotation-schema-foreign-key-not-null ( -- )
 225     annotation "ANNOTATION"
 226     {
 227         { "n" "ID" +db-assigned-id+ }
 228         { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "ID" } +not-null+ }
 229         { "summary" "SUMMARY" TEXT }
 230         { "author" "AUTHOR" TEXT }
 231         { "mode" "MODE" TEXT }
 232         { "contents" "CONTENTS" TEXT }
 233     } define-persistent ;
 234
 235 : annotation-schema-cascade ( -- )
 236     annotation "ANNOTATION"
 237     {
 238         { "n" "ID" +db-assigned-id+ }
 239         { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "ID" }
 240             +on-delete+ +cascade+ }
 241         { "summary" "SUMMARY" TEXT }
 242         { "author" "AUTHOR" TEXT }
 243         { "mode" "MODE" TEXT }
 244         { "contents" "CONTENTS" TEXT }
 245     } define-persistent ;
 246
 247 : annotation-schema-restrict ( -- )
 248     annotation "ANNOTATION"
 249     {
 250         { "n" "ID" +db-assigned-id+ }
 251         { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "ID" } }
 252         { "summary" "SUMMARY" TEXT }
 253         { "author" "AUTHOR" TEXT }
 254         { "mode" "MODE" TEXT }
 255         { "contents" "CONTENTS" TEXT }
 256     } define-persistent ;
 257
 258 : test-paste-schema ( -- )
 259     [ ] [ paste ensure-table ] unit-test
 260     [ ] [ annotation ensure-table ] unit-test
 261     [ ] [ annotation drop-table ] unit-test
 262     [ ] [ paste drop-table ] unit-test
 263     [ ] [ paste create-table ] unit-test
 264     [ ] [ annotation create-table ] unit-test
 265
 266     [ ] [
 267         paste new
 268             "summary1" >>summary
 269             "erg" >>author
 270             "#lol" >>channel
 271             "contents1" >>contents
 272             now >>timestamp
 273         insert-tuple
 274     ] unit-test
 275
 276     [ ] [
 277         annotation new
 278             1 >>paste-id
 279             "annotation1" >>summary
 280             "erg" >>author
 281             "annotation contents" >>contents
 282         insert-tuple
 283     ] unit-test ;
 284
 285 : test-foreign-key ( -- )
 286     [ ] [ annotation-schema-foreign-key ] unit-test
 287     test-paste-schema
 288     [ paste new 1 >>n delete-tuples ] must-fail ;
 289
 290 : test-foreign-key-not-null ( -- )
 291     [ ] [ annotation-schema-foreign-key-not-null ] unit-test
 292     test-paste-schema
 293     [ paste new 1 >>n delete-tuples ] must-fail ;
 294
 295 : test-cascade ( -- )
 296     [ ] [ annotation-schema-cascade ] unit-test
 297     test-paste-schema
 298     [ ] [ paste new 1 >>n delete-tuples ] unit-test
 299     [ 0 ] [ paste new select-tuples length ] unit-test ;
 300
 301 : test-restrict ( -- )
 302     [ ] [ annotation-schema-restrict ] unit-test
 303     test-paste-schema
 304     [ paste new 1 >>n delete-tuples ] must-fail ;
 305
 306 [ test-foreign-key ] test-sqlite
 307 [ test-foreign-key-not-null ] test-sqlite
 308 [ test-cascade ] test-sqlite
 309 [ test-restrict ] test-sqlite
 310
 311 [ test-foreign-key ] test-postgresql
 312 [ test-foreign-key-not-null ] test-postgresql
 313 [ test-cascade ] test-postgresql
 314 [ test-restrict ] test-postgresql
 315
 316 : test-repeated-insert
 317     [ ] [ person ensure-table ] unit-test
 318     [ ] [ person1 get insert-tuple ] unit-test
 319     [ person1 get insert-tuple ] must-fail ;
 320
 321 TUPLE: serialize-me id data ;
 322
 323 : test-serialize ( -- )
 324     serialize-me "SERIALIZED"
 325     {
 326         { "id" "ID" +db-assigned-id+ }
 327         { "data" "DATA" FACTOR-BLOB }
 328     } define-persistent
 329     [ serialize-me drop-table ] [ drop ] recover
 330     [ ] [ serialize-me create-table ] unit-test
 331
 332     [ ] [ T{ serialize-me f f H{ { 1 2 } } } insert-tuple ] unit-test
 333     [
 334         { T{ serialize-me f 1 H{ { 1 2 } } } }
 335     ] [ T{ serialize-me f 1 } select-tuples ] unit-test ;
 336
 337 TUPLE: exam id name score ;
 338
 339 : random-exam ( -- exam )
 340         f
 341         6 [ CHAR: a CHAR: z [a,b] random ] replicate >string
 342         100 random
 343     exam boa ;
 344
 345 : test-intervals ( -- )
 346     [
 347         exam "EXAM"
 348         {
 349             { "idd" "ID" +db-assigned-id+ }
 350             { "named" "NAME" TEXT }
 351             { "score" "SCORE" INTEGER }
 352         } define-persistent
 353     ] [
 354         seq>> { "idd" "named" } =
 355     ] must-fail-with
 356
 357     exam "EXAM"
 358     {
 359         { "id" "ID" +db-assigned-id+ }
 360         { "name" "NAME" TEXT }
 361         { "score" "SCORE" INTEGER }
 362     } define-persistent
 363     [ exam drop-table ] [ drop ] recover
 364     [ ] [ exam create-table ] unit-test
 365
 366     [ ] [ T{ exam f f "Kyle" 100 } insert-tuple ] unit-test
 367     [ ] [ T{ exam f f "Stan" 80 } insert-tuple ] unit-test
 368     [ ] [ T{ exam f f "Kenny" 60 } insert-tuple ] unit-test
 369     [ ] [ T{ exam f f "Cartman" 41 } insert-tuple ] unit-test
 370
 371     [ 4 ]
 372     [ T{ exam { name IGNORE } { score IGNORE } } select-tuples length ] unit-test
 373
 374     [ f ]
 375     [ T{ exam { name IGNORE } { score IGNORE } } select-tuples first score>> ] unit-test
 376
 377     [ T{ exam { name IGNORE } { score IGNORE } { id IGNORE } } select-tuples first score>> ] [ class>> "EXAM" = ] must-fail-with
 378
 379     [
 380         {
 381             T{ exam f 3 "Kenny" 60 }
 382             T{ exam f 4 "Cartman" 41 }
 383         }
 384     ] [
 385         T{ exam f f f T{ interval f { 0 t } { 70 t } } } select-tuples
 386     ] unit-test
 387
 388     [
 389         { }
 390     ] [
 391         T{ exam f T{ interval f { 3 f } { 4 f } } f } select-tuples
 392     ] unit-test
 393     [
 394         {
 395             T{ exam f 4 "Cartman" 41 }
 396         }
 397     ] [
 398         T{ exam f T{ interval f { 3 f } { 4 t } } f } select-tuples
 399     ] unit-test
 400     [
 401         {
 402             T{ exam f 3 "Kenny" 60 }
 403         }
 404     ] [
 405         T{ exam f T{ interval f { 3 t } { 4 f } } f } select-tuples
 406     ] unit-test
 407     [
 408         {
 409             T{ exam f 3 "Kenny" 60 }
 410             T{ exam f 4 "Cartman" 41 }
 411         }
 412     ] [
 413         T{ exam f T{ interval f { 3 t } { 4 t } } f } select-tuples
 414     ] unit-test
 415
 416     [
 417         {
 418             T{ exam f 1 "Kyle" 100 }
 419             T{ exam f 2 "Stan" 80 }
 420         }
 421     ] [
 422         T{ exam f f { "Stan" "Kyle" } } select-tuples
 423     ] unit-test
 424
 425     [
 426         {
 427             T{ exam f 1 "Kyle" 100 }
 428             T{ exam f 2 "Stan" 80 }
 429             T{ exam f 3 "Kenny" 60 }
 430         }
 431     ] [
 432         T{ exam f T{ range f 1 3 1 } } select-tuples
 433     ] unit-test
 434
 435     [
 436         {
 437             T{ exam f 2 "Stan" 80 }
 438             T{ exam f 3 "Kenny" 60 }
 439             T{ exam f 4 "Cartman" 41 }
 440         }
 441     ] [
 442         T{ exam f T{ interval f { 2 t } { 1.0/0.0 f } } } select-tuples
 443     ] unit-test
 444
 445     [
 446         {
 447             T{ exam f 1 "Kyle" 100 }
 448         }
 449     ] [
 450         T{ exam f T{ interval f { -1.0/0.0 t } { 2 f } } } select-tuples
 451     ] unit-test
 452
 453     [
 454         {
 455             T{ exam f 1 "Kyle" 100 }
 456             T{ exam f 2 "Stan" 80 }
 457             T{ exam f 3 "Kenny" 60 }
 458             T{ exam f 4 "Cartman" 41 }
 459         }
 460     ] [
 461         T{ exam f T{ interval f { -1.0/0.0 t } { 1/0. f } } } select-tuples
 462     ] unit-test
 463
 464     [
 465         {
 466             T{ exam f 1 "Kyle" 100 }
 467             T{ exam f 2 "Stan" 80 }
 468             T{ exam f 3 "Kenny" 60 }
 469             T{ exam f 4 "Cartman" 41 }
 470         }
 471     ] [
 472         T{ exam } select-tuples
 473     ] unit-test
 474
 475     [ 4 ] [ T{ exam } count-tuples ] unit-test ;
 476
 477 TUPLE: bignum-test id m n o ;
 478 : <bignum-test> ( m n o -- obj )
 479     bignum-test new
 480         swap >>o
 481         swap >>n
 482         swap >>m ;
 483
 484 : test-bignum
 485     bignum-test "BIGNUM_TEST"
 486     {
 487         { "id" "ID" +db-assigned-id+ }
 488         { "m" "M" BIG-INTEGER }
 489         { "n" "N" UNSIGNED-BIG-INTEGER }
 490         { "o" "O" SIGNED-BIG-INTEGER }
 491     } define-persistent
 492     [ bignum-test drop-table ] ignore-errors
 493     [ ] [ bignum-test ensure-table ] unit-test
 494     [ ] [ 63 2^ 1- dup dup <bignum-test> insert-tuple ] unit-test ;
 495
 496     ! sqlite only
 497     ! [ T{ bignum-test f 1
 498         ! -9223372036854775808 9223372036854775808 -9223372036854775808 } ]
 499     ! [ T{ bignum-test f 1 } select-tuple ] unit-test ;
 500
 501 TUPLE: secret n message ;
 502 C: <secret> secret
 503
 504 : test-random-id
 505     secret "SECRET"
 506     {
 507         { "n" "ID" +random-id+ system-random-generator }
 508         { "message" "MESSAGE" TEXT }
 509     } define-persistent
 510
 511     [ ] [ secret recreate-table ] unit-test
 512
 513     [ t ] [ f "kilroy was here" <secret> [ insert-tuple ] keep n>> integer? ] unit-test
 514
 515     [ ] [ f "kilroy was here2" <secret> insert-tuple ] unit-test
 516
 517     [ ] [ f "kilroy was here3" <secret> insert-tuple ] unit-test
 518
 519     [ t ] [
 520         T{ secret } select-tuples
 521         first message>> "kilroy was here" head?
 522     ] unit-test
 523
 524     [ t ] [
 525         T{ secret } select-tuples length 3 =
 526     ] unit-test ;
 527
 528 [ db-assigned-person-schema test-tuples ] test-sqlite
 529 [ user-assigned-person-schema test-tuples ] test-sqlite
 530 [ user-assigned-person-schema test-repeated-insert ] test-sqlite
 531 [ test-bignum ] test-sqlite
 532 [ test-serialize ] test-sqlite
 533 [ test-intervals ] test-sqlite
 534 [ test-random-id ] test-sqlite
 535
 536 [ db-assigned-person-schema test-tuples ] test-postgresql
 537 [ user-assigned-person-schema test-tuples ] test-postgresql
 538 [ user-assigned-person-schema test-repeated-insert ] test-postgresql
 539 [ test-bignum ] test-postgresql
 540 [ test-serialize ] test-postgresql
 541 [ test-intervals ] test-postgresql
 542 [ test-random-id ] test-postgresql
 543
 544 TUPLE: does-not-persist ;
 545
 546 [
 547     [ does-not-persist create-sql-statement ]
 548     [ class \ not-persistent = ] must-fail-with
 549 ] test-sqlite
 550
 551 [
 552     [ does-not-persist create-sql-statement ]
 553     [ class \ not-persistent = ] must-fail-with
 554 ] test-postgresql
 555
 556
 557 TUPLE: suparclass id a ;
 558
 559 suparclass f {
 560     { "id" "ID" +db-assigned-id+ }
 561     { "a" "A" INTEGER }
 562 } define-persistent
 563
 564 TUPLE: subbclass < suparclass b ;
 565
 566 subbclass "SUBCLASS" {
 567     { "b" "B" TEXT }
 568 } define-persistent
 569
 570 TUPLE: fubbclass < subbclass ;
 571
 572 fubbclass "FUBCLASS" { } define-persistent
 573
 574 : test-db-inheritance ( -- )
 575     [ ] [ subbclass ensure-table ] unit-test
 576     [ ] [ fubbclass ensure-table ] unit-test
 577
 578     [ ] [
 579         subbclass new 5 >>a "hi" >>b dup insert-tuple id>> "id" set
 580     ] unit-test
 581
 582     [ t "hi" 5 ] [
 583         subbclass new "id" get >>id select-tuple
 584         [ subbclass? ] [ b>> ] [ a>> ] tri
 585     ] unit-test
 586
 587     [ ] [ fubbclass new 0 >>a "hi" >>b insert-tuple ] unit-test
 588
 589     [ t ] [ fubbclass new select-tuples [ fubbclass? ] all? ] unit-test ;
 590
 591 [ test-db-inheritance ] test-sqlite
 592 [ test-db-inheritance ] test-postgresql
 593
 594
 595 TUPLE: string-encoding-test id string ;
 596
 597 string-encoding-test "STRING_ENCODING_TEST" {
 598     { "id" "ID" +db-assigned-id+ }
 599     { "string" "STRING" TEXT }
 600 } define-persistent
 601
 602 : test-string-encoding ( -- )
 603     [ ] [ string-encoding-test ensure-table ] unit-test
 604
 605     [ ] [
 606         string-encoding-test new
 607             "\u{copyright-sign}\u{bengali-letter-cha}" >>string
 608         [ insert-tuple ] [ id>> "id" set ] bi
 609     ] unit-test
 610
 611     [ "\u{copyright-sign}\u{bengali-letter-cha}" ] [
 612         string-encoding-test new "id" get >>id select-tuple string>>
 613     ] unit-test ;
 614
 615 [ test-string-encoding ] test-sqlite
 616 [ test-string-encoding ] test-postgresql
 617
 618 ! Don't comment these out. These words must infer
 619 \ bind-tuple must-infer
 620 \ insert-tuple must-infer
 621 \ update-tuple must-infer
 622 \ delete-tuples must-infer
 623 \ select-tuple must-infer
 624 \ define-persistent must-infer
 625 \ ensure-table must-infer
 626 \ create-table must-infer
 627 \ drop-table must-infer
 628
 629 : test-queries ( -- )
 630     [ ] [ exam ensure-table ] unit-test
 631     [ ] [ 1000 [ random-exam insert-tuple ] times ] unit-test
 632     [ 5 ] [
 633         <query>
 634         T{ exam { score T{ interval { from { 0 t } } { to { 100 t } } } } }
 635             >>tuple
 636         5 >>limit select-tuples length
 637     ] unit-test ;
 638
 639 TUPLE: compound-foo a b c ;
 640
 641 compound-foo "COMPOUND_FOO"
 642 {
 643     { "a" "A" INTEGER +user-assigned-id+ }
 644     { "b" "B" INTEGER +user-assigned-id+ }
 645     { "c" "C" INTEGER }
 646 } define-persistent
 647
 648 : test-compound-primary-key ( -- )
 649     [ ] [ compound-foo ensure-table ] unit-test
 650     [ ] [ compound-foo drop-table ] unit-test
 651     [ ] [ compound-foo create-table ] unit-test
 652     [ ] [ 1 2 3 compound-foo boa insert-tuple ] unit-test
 653     [ 1 2 3 compound-foo boa insert-tuple ] must-fail
 654     [ ] [ 2 3 4 compound-foo boa insert-tuple ] unit-test
 655     [ T{ compound-foo { a 2 } { b 3 } { c 4 } } ]
 656     [ compound-foo new 4 >>c select-tuple ] unit-test ;
 657
 658 [ test-compound-primary-key ] test-sqlite
 659 [ test-compound-primary-key ] test-postgresql