From 2268daf80771f83a19010a6ac923fb934b68a738 Mon Sep 17 00:00:00 2001 From: Oldes Huhuman Date: Tue, 4 Jun 2024 15:07:29 +0200 Subject: [PATCH] TEST: sqlite scheme --- .github/workflows/main.yml | 15 +- .gitignore | 2 +- ci-test.r3 | 121 +++++++++++++++ sqlite-scheme.r3 | 270 ---------------------------------- sqlite-scheme.reb | 143 ++++++++++++++++++ src/sqlite-rebol-extension.r3 | 31 ++-- 6 files changed, 287 insertions(+), 295 deletions(-) delete mode 100644 sqlite-scheme.r3 create mode 100644 sqlite-scheme.reb diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index b80ab23..96e752e 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -31,12 +31,9 @@ jobs: - name: Install Rebol for extension test uses: oldes/install-rebol@v3.17.0 - - name: Test SQLite raw extension + - name: Test SQLite extension run: ./rebol3 ci-test.r3 - - name: Test SQLite scheme - run: ./rebol3 sqlite-scheme.r3 - ############################################################################### # Collecting build artifacts... - uses: actions/upload-artifact@v3 @@ -77,12 +74,9 @@ jobs: - name: Install Rebol for extension test uses: oldes/install-rebol@v3.17.0 - - name: Test SQLite raw extension + - name: Test SQLite extension run: ./rebol3 ci-test.r3 - - name: Test SQLite scheme - run: ./rebol3 sqlite-scheme.r3 - - name: Compress 64bit Rebol SQLite extension run: gzip -9 ./sqlite-linux-x64.rebx @@ -109,12 +103,9 @@ jobs: - name: Install Rebol for extension test uses: oldes/install-rebol@v3.17.0 - - name: Test SQLite raw extension + - name: Test SQLite extension run: ./rebol3 ci-test.r3 - - name: Test SQLite scheme - run: ./rebol3 sqlite-scheme.r3 - - name: Compress 64bit Rebol SQLite extension run: gzip -9 ./sqlite-macos-x64.rebx diff --git a/.gitignore b/.gitignore index 71e4f7e..51e1483 100644 --- a/.gitignore +++ b/.gitignore @@ -9,4 +9,4 @@ !README.md !LICENSE !ci-test.r3 -!sqlite-scheme.r3 \ No newline at end of file +!sqlite-scheme.reb \ No newline at end of file diff --git a/ci-test.r3 b/ci-test.r3 index 0e3e932..9eb3846 100644 --- a/ci-test.r3 +++ b/ci-test.r3 @@ -187,5 +187,126 @@ COMMIT;} print info print "SQLite tests done." ] + + +;------------------------------------------------------------------------------------------------ +print-horizontal-line +print as-yellow "SQLITE SCHEME TESTS" +print-horizontal-line + +import %sqlite-scheme.reb + +if exists? %chinook.db [ + db: open/new sqlite:chinook.db + + probe read insert db {SELECT + InvoiceId, + BillingAddress, + date(InvoiceDate) InvoiceDate, + Total + FROM + invoices + WHERE + InvoiceDate NOT BETWEEN '2009-01-03' AND '2013-12-01' + ORDER BY + InvoiceDate; + } +] + +;open sqlite:new.db ;; would throw an error, if the file ./new.db does not exists +;open sqlite:/home/oldes/new.db ;; used full path to the DB file + +print-horizontal-line +prin as-yellow "Testing an error message, when trying to open a database using not existing dir." +print try [open/new sqlite:not-exists/dir] + +;; Create a new DB file in the current dir, if it does not exists, and open it +db: open/new sqlite:new.db + +;; Allow verbose SQLite traces... +modify db 'trace-level 3 ;= SQLITE_TRACE_STMT or SQLITE_TRACE_PROFILE + +;; Execute multiple queries at once... +write db { +BEGIN TRANSACTION; +/* delete any tables used in the test */ +DROP TABLE IF EXISTS t1; +DROP TABLE IF EXISTS t2; +DROP TABLE IF EXISTS Cars; +DROP TABLE IF EXISTS Contacts; +/* ---------------------------------- */ +CREATE TABLE Cars(Id INTEGER PRIMARY KEY, Name TEXT, Price INTEGER); +INSERT INTO "Cars" VALUES(1,'Audi',52642); +INSERT INTO "Cars" VALUES(2,'Mercedes',57127); +INSERT INTO "Cars" VALUES(3,'Skoda',9000); +INSERT INTO "Cars" VALUES(4,'Volvo',29000); +INSERT INTO "Cars" VALUES(5,'Bentley',350000); +INSERT INTO "Cars" VALUES(6,'Citroen',21000); +INSERT INTO "Cars" VALUES(7,'Hummer',41400); +INSERT INTO "Cars" VALUES(NULL,'Audi',52642); +INSERT INTO "Cars" VALUES(NULL,'Mercedes',57127); +INSERT INTO "Cars" VALUES(NULL,'Skoda',9000); +INSERT INTO "Cars" VALUES(NULL,'Volvo',29000); +INSERT INTO "Cars" VALUES(NULL,'Bentley',350000); +INSERT INTO "Cars" VALUES(NULL,'Citroen',21000); +INSERT INTO "Cars" VALUES(NULL,'Hummer',41400); +INSERT INTO "Cars" VALUES(NULL,'Audi',52642); +INSERT INTO "Cars" VALUES(NULL,'Mercedes',57127); +INSERT INTO "Cars" VALUES(NULL,'Skoda',9000); +INSERT INTO "Cars" VALUES(NULL,'Volvo',29000); +INSERT INTO "Cars" VALUES(NULL,'Bentley',350000); +INSERT INTO "Cars" VALUES(NULL,'Citroen',21000); +INSERT INTO "Cars" VALUES(NULL,'Hummer',41400); +INSERT INTO "Cars" VALUES(NULL,'Audi',52642); +INSERT INTO "Cars" VALUES(NULL,'Mercedes',57127); +INSERT INTO "Cars" VALUES(NULL,'Skoda',9000); +INSERT INTO "Cars" VALUES(NULL,'Volvo',29000); +INSERT INTO "Cars" VALUES(NULL,'Bentley',350000); +INSERT INTO "Cars" VALUES(NULL,'Citroen',21000); +INSERT INTO "Cars" VALUES(NULL,'Hummer',41400); +INSERT INTO "Cars" VALUES(NULL,'Audi',52642); +INSERT INTO "Cars" VALUES(NULL,'Mercedes',57127); +INSERT INTO "Cars" VALUES(NULL,'Skoda',9000); +INSERT INTO "Cars" VALUES(NULL,'Volvo',29000); +INSERT INTO "Cars" VALUES(NULL,'Bentley',350000); +INSERT INTO "Cars" VALUES(NULL,'Citroen',21000); +INSERT INTO "Cars" VALUES(NULL,'Hummer',41400); + +CREATE TABLE Contacts ( + email TEXT PRIMARY KEY, + first_name TEXT NOT NULL, + last_name TEXT NOT NULL +); +INSERT INTO "Contacts" VALUES('oceane.pacome@corporate.com', 'Océane', 'Pacôme'); +INSERT INTO "Contacts" VALUES('Oldes@corporate.com','Oldes', 'Huhuman'); +COMMIT; +} + +print-horizontal-line +prin as-yellow "Testing an error message of the invalid query." +print try [insert db "INVALID_QUERY"] + +print-horizontal-line + +insert db "SELECT * FROM Cars" ;; Prepares a statement +print as-yellow "Resolving 10 rows one by one..." +loop 10 [probe take db] +print as-yellow "Resolving 5 rows at once..." +probe read/part db 5 +print as-yellow "Resolving the rest of rows..." +probe read db + +print-horizontal-line +print as-yellow "Resolving 4 random hexadecimal blobs" +insert db "SELECT hex(randomblob(16)), hex(randomblob(16)), hex(randomblob(16)), hex(randomblob(16))" +probe read db + +print-horizontal-line +print as-yellow "Resolving all data using PICK action" +probe pick db "SELECT * FROM Contacts" + + +print as-yellow "DONE" + ;quit diff --git a/sqlite-scheme.r3 b/sqlite-scheme.r3 deleted file mode 100644 index 77cb4b7..0000000 --- a/sqlite-scheme.r3 +++ /dev/null @@ -1,270 +0,0 @@ -Rebol [ - title: "SQLite scheme (WIP)" - file: %sqlite-scheme.r3 - note: {This is just an initial proof of concept} - version: 0.1.0 - author: "Oldes" - needs: 3.13.1 ;; using system/options/modules as extension location -] - -print "Trying to import SQLite extension..." -;; In the GitHub Actions, the built extension is copied into the current directory. -unless empty? read %sqlite*.rebx [ - ;; make sure that we load a fresh extension - try [system/modules/sqlite: none] - ;; use current directory as a modules location - system/options/modules: what-dir -] - -sqlite: import sqlite - -sys/make-scheme [ - title: "SQLite database scheme" - name: 'sqlite - spec: make system/standard/port-spec-file [] - - actor: [ - open: func [ - port[port! url!] - /new - /local path - ][ - ;? port/spec - path: rejoin [ - any [select port/spec 'path %./] - any [select port/spec 'target %.db] - ] - port/spec/path: copy path: clean-path path - if all [not new not exists? path][ - cause-error 'Access 'cannot-open reduce [path "file not exists!"] - ] - ;; SQLite expect full path in the local format (C:/ on Windows) - ;; but Rebol's open function does not accept string... - ;; so do this strange thing to get over it - all [ - system/platform = 'Windows - path: as file! to-local-file path - ] - port/state: make object! [ - db: sqlite/open path ;; used to store a database handle - statements: #() ;; prepared statements - query: ;; last used query - stmt: #[none] ;; last prepared statement - trace-level: 0 - ] - return port - ] - - open?: func [port [port!]][ - handle? port/state/db - ] - - close: func [port [port!] /local state][ - unless open? port [ cause-error 'Access 'not-open port/spec/ref ] - state: port/state - sqlite/close state/db - foreach [query stmt] state/statements [ - sqlite/finalize stmt - ] - clear state/statements - state/db: - state/query: - state/stmt: none - port - ] - - ;; WRITE now just executes a query... no result is collected, but may be printed in console - write: func[port [port!] query [string!]][ - unless open? port [ cause-error 'Access 'not-open port/spec/ref ] - sqlite/exec port/state/db port/state/query: query - ] - - ;; INSERT is used to prepare a statement, which is then used with other actions - insert: func[port [port!] query [string!] /local ps stmt][ - unless open? port [ cause-error 'Access 'not-open port/spec/ref ] - ps: port/state - ps/query: query - either stmt: select ps/statements query [ - ;; make sure that the statement starts from begining - sqlite/reset stmt - ][ - ;; prepare the new statement and store it for later use - stmt: sqlite/prepare ps/db query - ps/statements/:query: stmt - ] - ps/stmt: stmt - port - ] - - ;; TAKE used to get just a single row (or multiple) - take: func[ - port [port!] - /part length [integer!] - ][ - read/part port any [length 1] - ] - - ;; READ used to get all rows if used without refinement (or multiple when used with /part) - read: func[ - port [port!] - /part length [integer!] - /local stmt temp data - ][ - unless open? port [ cause-error 'Access 'not-open port/spec/ref ] - stmt: port/state/stmt - port/data: data: clear any [port/data []] - - temp: sqlite/step/rows stmt any [length 0] - either block? temp [ - append data temp - unless part [ - ;; gets all rows - while [ - block? temp: sqlite/step/rows stmt 0 - ][ append data temp ] - sqlite/reset stmt - ] - ][ - return none - ] - data - ] - - ;; PICK is a shortcut for READ INSERT "query" - pick: func[ - port [port!] - query [string!] - ][ - read insert port query - ] - - modify: func[ - port [port!] - field [word!] - value [integer!] - ][ - switch field [ - trace-level [ - sqlite/trace port/state/db port/state/trace-level: value - ] - ] - ] - ] -] - -;------------------------------------------------------------------------------------------------ -;print sqlite/info - -db: open/new sqlite:chinook.db - -probe read insert db {SELECT - InvoiceId, - BillingAddress, - date(InvoiceDate) InvoiceDate, - Total -FROM - invoices -WHERE - InvoiceDate NOT BETWEEN '2009-01-03' AND '2013-12-01' -ORDER BY - InvoiceDate; -} -quit - -;open sqlite:new.db ;; would throw an error, if the file ./new.db does not exists -;open sqlite:/home/oldes/new.db ;; used full path to the DB file - -print-horizontal-line -prin as-yellow "Testing an error message, when trying to open a database using not existing dir." -print try [open/new sqlite:not-exists/dir] - -;; Create a new DB file in the current dir, if it does not exists, and open it -db: open/new sqlite:new.db - -;; Allow verbose SQLite traces... -modify db 'trace-level 3 ;= SQLITE_TRACE_STMT or SQLITE_TRACE_PROFILE - -;; Execute multiple queries at once... -write db { -BEGIN TRANSACTION; -/* delete any tables used in the test */ -DROP TABLE IF EXISTS t1; -DROP TABLE IF EXISTS t2; -DROP TABLE IF EXISTS Cars; -DROP TABLE IF EXISTS Contacts; -/* ---------------------------------- */ -CREATE TABLE Cars(Id INTEGER PRIMARY KEY, Name TEXT, Price INTEGER); -INSERT INTO "Cars" VALUES(1,'Audi',52642); -INSERT INTO "Cars" VALUES(2,'Mercedes',57127); -INSERT INTO "Cars" VALUES(3,'Skoda',9000); -INSERT INTO "Cars" VALUES(4,'Volvo',29000); -INSERT INTO "Cars" VALUES(5,'Bentley',350000); -INSERT INTO "Cars" VALUES(6,'Citroen',21000); -INSERT INTO "Cars" VALUES(7,'Hummer',41400); -INSERT INTO "Cars" VALUES(NULL,'Audi',52642); -INSERT INTO "Cars" VALUES(NULL,'Mercedes',57127); -INSERT INTO "Cars" VALUES(NULL,'Skoda',9000); -INSERT INTO "Cars" VALUES(NULL,'Volvo',29000); -INSERT INTO "Cars" VALUES(NULL,'Bentley',350000); -INSERT INTO "Cars" VALUES(NULL,'Citroen',21000); -INSERT INTO "Cars" VALUES(NULL,'Hummer',41400); -INSERT INTO "Cars" VALUES(NULL,'Audi',52642); -INSERT INTO "Cars" VALUES(NULL,'Mercedes',57127); -INSERT INTO "Cars" VALUES(NULL,'Skoda',9000); -INSERT INTO "Cars" VALUES(NULL,'Volvo',29000); -INSERT INTO "Cars" VALUES(NULL,'Bentley',350000); -INSERT INTO "Cars" VALUES(NULL,'Citroen',21000); -INSERT INTO "Cars" VALUES(NULL,'Hummer',41400); -INSERT INTO "Cars" VALUES(NULL,'Audi',52642); -INSERT INTO "Cars" VALUES(NULL,'Mercedes',57127); -INSERT INTO "Cars" VALUES(NULL,'Skoda',9000); -INSERT INTO "Cars" VALUES(NULL,'Volvo',29000); -INSERT INTO "Cars" VALUES(NULL,'Bentley',350000); -INSERT INTO "Cars" VALUES(NULL,'Citroen',21000); -INSERT INTO "Cars" VALUES(NULL,'Hummer',41400); -INSERT INTO "Cars" VALUES(NULL,'Audi',52642); -INSERT INTO "Cars" VALUES(NULL,'Mercedes',57127); -INSERT INTO "Cars" VALUES(NULL,'Skoda',9000); -INSERT INTO "Cars" VALUES(NULL,'Volvo',29000); -INSERT INTO "Cars" VALUES(NULL,'Bentley',350000); -INSERT INTO "Cars" VALUES(NULL,'Citroen',21000); -INSERT INTO "Cars" VALUES(NULL,'Hummer',41400); - -CREATE TABLE Contacts ( - email TEXT PRIMARY KEY, - first_name TEXT NOT NULL, - last_name TEXT NOT NULL -); -INSERT INTO "Contacts" VALUES('oceane.pacome@corporate.com', 'Océane', 'Pacôme'); -INSERT INTO "Contacts" VALUES('Oldes@corporate.com','Oldes', 'Huhuman'); -COMMIT; -} - -print-horizontal-line -prin as-yellow "Testing an error message of the invalid query." -print try [insert db "INVALID_QUERY"] - -print-horizontal-line - -insert db "SELECT * FROM Cars" ;; Prepares a statement -print as-yellow "Resolving 10 rows one by one..." -loop 10 [probe take db] -print as-yellow "Resolving 5 rows at once..." -probe read/part db 5 -print as-yellow "Resolving the rest of rows..." -probe read db - -print-horizontal-line -print as-yellow "Resolving 4 random hexadecimal blobs" -insert db "SELECT hex(randomblob(16)), hex(randomblob(16)), hex(randomblob(16)), hex(randomblob(16))" -probe read db - -print-horizontal-line -print as-yellow "Resolving all data using PICK action" -probe pick db "SELECT * FROM Contacts" - - -print as-yellow "DONE" - - - diff --git a/sqlite-scheme.reb b/sqlite-scheme.reb new file mode 100644 index 0000000..0c7cb67 --- /dev/null +++ b/sqlite-scheme.reb @@ -0,0 +1,143 @@ +Rebol [ + title: "SQLite scheme (WIP)" + file: %sqlite-scheme.reb + note: {This is just an initial proof of concept} + version: 0.1.0 + author: "Oldes" + needs: 3.13.1 ;; using system/options/modules as extension location +] + +sys/make-scheme [ + title: "SQLite database scheme" + name: 'sqlite + spec: make system/standard/port-spec-file [] + sqlite: import sqlite + + actor: [ + open: func [ + port[port! url!] + /new + /local path + ][ + ;? port/spec + path: rejoin [ + any [select port/spec 'path %./] + any [select port/spec 'target %.db] + ] + port/spec/path: copy path: clean-path path + if all [not new not exists? path][ + cause-error 'Access 'cannot-open reduce [path "file not exists!"] + ] + ;; SQLite expect full path in the local format (C:/ on Windows) + ;; but Rebol's open function does not accept string... + ;; so do this strange thing to get over it + all [ + system/platform = 'Windows + path: as file! to-local-file path + ] + port/state: make object! [ + db: sqlite/open path ;; used to store a database handle + statements: make map! 0 ;; prepared statements + query: ;; last used query + stmt: none ;; last prepared statement + trace-level: 0 + ] + return port + ] + + open?: func [port [port!]][ + handle? port/state/db + ] + + close: func [port [port!] /local state][ + unless open? port [ cause-error 'Access 'not-open port/spec/ref ] + state: port/state + sqlite/close state/db + foreach [query stmt] state/statements [ + sqlite/finalize stmt + ] + clear state/statements + state/db: + state/query: + state/stmt: none + port + ] + + ;; WRITE now just executes a query... no result is collected, but may be printed in console + write: func[port [port!] query [string!]][ + unless open? port [ cause-error 'Access 'not-open port/spec/ref ] + sqlite/exec port/state/db port/state/query: query + ] + + ;; INSERT is used to prepare a statement, which is then used with other actions + insert: func[port [port!] query [string!] /local ps stmt][ + unless open? port [ cause-error 'Access 'not-open port/spec/ref ] + ps: port/state + ps/query: query + either stmt: select ps/statements query [ + ;; make sure that the statement starts from begining + sqlite/reset stmt + ][ + ;; prepare the new statement and store it for later use + stmt: sqlite/prepare ps/db query + ps/statements/:query: stmt + ] + ps/stmt: stmt + port + ] + + ;; TAKE used to get just a single row (or multiple) + take: func[ + port [port!] + /part length [integer!] + ][ + read/part port any [length 1] + ] + + ;; READ used to get all rows if used without refinement (or multiple when used with /part) + read: func[ + port [port!] + /part length [integer!] + /local stmt temp data + ][ + unless open? port [ cause-error 'Access 'not-open port/spec/ref ] + stmt: port/state/stmt + port/data: data: clear any [port/data []] + + temp: sqlite/step/rows stmt any [length 0] + either block? temp [ + append data temp + unless part [ + ;; gets all rows + while [ + block? temp: sqlite/step/rows stmt 0 + ][ append data temp ] + sqlite/reset stmt + ] + ][ + return none + ] + data + ] + + ;; PICK is a shortcut for READ INSERT "query" + pick: func[ + port [port!] + query [string!] + ][ + read insert port query + ] + + modify: func[ + port [port!] + field [word!] + value [integer!] + ][ + switch field [ + trace-level [ + sqlite/trace port/state/db port/state/trace-level: value + ] + ] + ] + ] +] diff --git a/src/sqlite-rebol-extension.r3 b/src/sqlite-rebol-extension.r3 index da0afd9..434d8f9 100644 --- a/src/sqlite-rebol-extension.r3 +++ b/src/sqlite-rebol-extension.r3 @@ -76,13 +76,27 @@ commands: [ reb-code: rejoin[ {REBOL [Title: "Rebol SQLite Extension"} { Name: sqlite Type: module Exports: []} - { Version: 3.44.2.0} + { Version: 3.46.0.0} + { Needs: 3.13.1} { Author: Oldes} - { Date: } now - { License: Apache-2.0} + { Date: } now/utc + { License: MIT} { Url: https://github.com/Siskin-framework/Rebol-SQLite} #"]" ] +logo: next { +// ____ __ __ ______ __ +// / __ \/ /__/ /__ ___ /_ __/__ ____/ / +// / /_/ / / _ / -_|_-<_ / / / -_) __/ _ \ +// \____/_/\_,_/\__/___(@)_/ \__/\__/_// / +// ~~~ oldes.huhuman at gmail.com ~~~ /_/ +// +// Project: Rebol/SQLite extension +// SPDX-License-Identifier: MIT +// ============================================================================= +// NOTE: auto-generated file, do not modify! +} + enu-commands: "" ;; command name enumerations cmd-declares: "" ;; command function declarations cmd-dispatch: "" ;; command functionm dispatcher @@ -115,11 +129,7 @@ foreach line split reb-code lf [ ] ;-- C file templates ----------------------------------------------------------- -header: next { -// -// Rebol/SQLite extension -// auto-generated file, do not modify! // - +header: {$logo #include "sqlite-command.h" #define MIN_REBOL_VER 3 @@ -145,10 +155,7 @@ typedef int (*MyCommandPointer)(RXIFRM *frm, void *ctx); } ;;------------------------------------------------------------------------------ -ctable: next { -// -// auto-generated file, do not modify! -// +ctable: {$logo #include "sqlite-rebol-extension.h" MyCommandPointer Command[] = { $cmd-dispatch};