From aacf4438229711d1704b2b093d3ceb9f6cc7a615 Mon Sep 17 00:00:00 2001 From: Kevin Nowaczyk Date: Tue, 31 Oct 2023 11:47:39 -0400 Subject: [PATCH] Update Linting and buggy files (#48) Added linting Added missing files fixed typos --- .gitattributes | 10 + .github/workflows/lint_vba.yml | 42 ++-- .travis.yml | 25 --- README.md | 2 +- deploy.sh | 8 - src/ClassModules/SQLRecordset.cls | 4 +- src/ClassModules/iSQLRecordset.cls | 2 +- src/Forms/Login.frm | 68 +++--- testing/ClassModules/SQLTestRecordset.cls | 8 + testing/ClassModules/SQLlibDatabaseTests.cls | 150 ++++++------- testing/ClassModules/SQLlibDeleteTests.cls | 106 +++++----- testing/ClassModules/SQLlibInsertTests.cls | 172 +++++++-------- testing/ClassModules/SQLlibSelectTests.cls | 212 +++++++++---------- testing/ClassModules/SQLlibStaticTests.cls | 208 +++++++++--------- testing/ClassModules/SQLlibTests.cls | 56 +++++ testing/ClassModules/SQLlibUpdateTests.cls | 104 ++++----- 16 files changed, 603 insertions(+), 574 deletions(-) create mode 100644 .gitattributes delete mode 100644 .travis.yml delete mode 100644 deploy.sh create mode 100644 testing/ClassModules/SQLlibTests.cls diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..392f275 --- /dev/null +++ b/.gitattributes @@ -0,0 +1,10 @@ +# Set the default behavior, in case people don't have core.autocrlf set. +* text=auto + +# Declare files that will always have CRLF line endings on checkout. +*.cls text eol=crlf +*.frm text eol=crlf +*.bas text eol=crlf + +# Denote all files that are truly binary and should not be modified. +*.frx binary diff --git a/.github/workflows/lint_vba.yml b/.github/workflows/lint_vba.yml index 8431b5c..c5747d2 100644 --- a/.github/workflows/lint_vba.yml +++ b/.github/workflows/lint_vba.yml @@ -11,33 +11,21 @@ jobs: name: Test and Static Analysis runs-on: ubuntu-latest strategy: + fail-fast: false matrix: - php: ['8.2'] + python-version: ["3.11"] steps: - - name: Set up PHP - uses: shivammathur/setup-php@v2 - with: - php-version: ${{ matrix.php }} - tools: composer:v2 - - - name: Set up Node - uses: actions/setup-node@v1 - with: - node-version: '14.x' - - - name: Checkout code - uses: actions/checkout@v2 - with: - fetch-depth: 0 - - - name: Setup PHP Code Sniffer - run: | - composer require --no-install --no-update beakerboy/vba_tokenizer:dev-master - composer config repositories.beakerboy vcs https://github.com/Beakerboy/VBA_Tokenizer - composer update - - name: Lint - run: | - vendor/bin/phpcs --extensions=cls/vba,bas/vba,frm/vba --standard=vendor/beakerboy/vba_tokenizer/src/Standards/VBA src/Modules - vendor/bin/phpcs --extensions=cls/vba,bas/vba,frm/vba --standard=vendor/beakerboy/vba_tokenizer/src/Standards/VBA src/ClassModules - vendor/bin/phpcs --extensions=cls/vba,bas/vba,frm/vba --standard=vendor/beakerboy/vba_tokenizer/src/Standards/VBA src/Forms + - uses: actions/checkout@v3 + - name: Set up Python ${{ matrix.python-version }} + uses: actions/setup-python@v3 + with: + python-version: ${{ matrix.python-version }} + - name: Install dependencies + run: | + python -m pip install antlr4-tools + wget https://raw.githubusercontent.com/Beakerboy/VBA_Tokenizer/ANTLR/VbaLint + chmod +x VbaLint + - name: Lint with antlr + run: | + ./VbaLint \ No newline at end of file diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index db6c675..0000000 --- a/.travis.yml +++ /dev/null @@ -1,25 +0,0 @@ -language: vba -install: - - composer install - - sudo apt-get install -qq mono-complete - - sudo apt-get install -qq python3.5 - - git clone https://github.com/Beakerboy/Excel-Addin-Generator.git -script: - - vendor/bin/phpcs --extensions=cls/vba,bas/vba --standard=vendor/beakerboy/vba_tokenizer/src/Standards/VBA $TRAVIS_BUILD_DIR/src -deploy: - - provider: script - script: bash deploy.sh - on: - tags: true - - provider: pages - skip_cleanup: true - local_dir: $TRAVIS_BUILD_DIR/docs - github_token: $GH_REPO_TOKEN - on: - tags: true - - provider: releases - api_key: $GH_REPO_TOKEN - file: bin/SQLlib.xlam - skip_cleanup: true - on: - tags: true diff --git a/README.md b/README.md index d1b9f74..c8e4ee7 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -[![Build Status](https://travis-ci.org/Beakerboy/VBA-SQL-Library.svg?branch=master)](https://travis-ci.org/Beakerboy/VBA-SQL-Library) +[![Lint VBA](https://github.com/Beakerboy/VBA-SQL-Library/actions/workflows/lint_vba.yml/badge.svg?branch=master)](https://github.com/Beakerboy/VBA-SQL-Library/actions/workflows/lint_vba.yml) VBA SQL Library diff --git a/deploy.sh b/deploy.sh deleted file mode 100644 index c1e5150..0000000 --- a/deploy.sh +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/bash -wget https://www.naturaldocs.org/download/natural_docs/2.0.2/Natural_Docs_2.0.2.zip -O /tmp/ND.zip -unzip /tmp/ND.zip -d /tmp -mkdir $TRAVIS_BUILD_DIR/docs -mkdir $TRAVIS_BUILD_DIR/.ND_Config -cp .nd_project.txt $TRAVIS_BUILD_DIR/.ND_Config/Project.txt -mono /tmp/Natural\ Docs/NaturalDocs.exe $TRAVIS_BUILD_DIR/.ND_Config -python3.5 Excel-Addin-Generator/excelAddinGenerator/main.py $TRAVIS_BUILD_DIR/bin/vbaProject.bin bin/SQLlib.xlam diff --git a/src/ClassModules/SQLRecordset.cls b/src/ClassModules/SQLRecordset.cls index 95712be..28123b1 100644 --- a/src/ClassModules/SQLRecordset.cls +++ b/src/ClassModules/SQLRecordset.cls @@ -39,6 +39,6 @@ Public Function iSQLRecordset_GetRows(num As Integer) iSQLRecordset_GetRows = orst.GetRows(num) End Function -Public Property iSQLRecordset_EOF() +Property Get iSQLRecordset_EOF() iSQLRecordset_EOF = orst.EOF -End Function +End Property diff --git a/src/ClassModules/iSQLRecordset.cls b/src/ClassModules/iSQLRecordset.cls index e23908e..c5eabf0 100644 --- a/src/ClassModules/iSQLRecordset.cls +++ b/src/ClassModules/iSQLRecordset.cls @@ -37,6 +37,6 @@ Public Function State() End Function ' Property: EOF -Public Property EOF() +Property Get EOF() End Property diff --git a/src/Forms/Login.frm b/src/Forms/Login.frm index fc44d01..d392ef3 100644 --- a/src/Forms/Login.frm +++ b/src/Forms/Login.frm @@ -1,34 +1,34 @@ -VERSION 5.00 -Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Login - Caption = "Please Log In" - ClientHeight = 1920 - ClientLeft = 120 - ClientTop = 465 - ClientWidth = 2295 - OleObjectBlob = "Login.frx":0000 - StartUpPosition = 1 'CenterOwner -End -Attribute VB_Name = "Login" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Public Ready As Boolean - -Private Sub Form_Load() -Me.Show -Ready = False -Call Wait -'Label1.Visible = True -End Sub - -Public Function Wait() -Do While Ready = False - DoEvents -Loop -End Function - -Private Sub LoginButton_Click() - Ready = True - Me.Hide -End Sub +VERSION 5.00 +Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Login + Caption = "Please Log In" + ClientHeight = 1920 + ClientLeft = 120 + ClientTop = 465 + ClientWidth = 2295 + OleObjectBlob = "Login.frx":0000 + StartUpPosition = 1 'CenterOwner +End +Attribute VB_Name = "Login" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Public Ready As Boolean + +Private Sub Form_Load() +Me.Show +Ready = False +Call Wait +'Label1.Visible = True +End Sub + +Public Function Wait() +Do While Ready = False + DoEvents +Loop +End Function + +Private Sub LoginButton_Click() + Ready = True + Me.Hide +End Sub diff --git a/testing/ClassModules/SQLTestRecordset.cls b/testing/ClassModules/SQLTestRecordset.cls index 080725f..3037a05 100644 --- a/testing/ClassModules/SQLTestRecordset.cls +++ b/testing/ClassModules/SQLTestRecordset.cls @@ -27,3 +27,11 @@ Public Function iSQLRecordset_GetValue(MyFieldname) iSQLRecordset_GetValue = sQuery End Function +Public Function iSQLRecordset_GetRows(num As Integer) + iSQLRecordset_GetRows = num +End Function + +Property Get iSQLRecordset_EOF() + iSQLRecordset_EOF = False +End Property + diff --git a/testing/ClassModules/SQLlibDatabaseTests.cls b/testing/ClassModules/SQLlibDatabaseTests.cls index 4c1388c..fc142d9 100644 --- a/testing/ClassModules/SQLlibDatabaseTests.cls +++ b/testing/ClassModules/SQLlibDatabaseTests.cls @@ -1,75 +1,75 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "SQLlibDatabaseTests" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = False -Implements iTestCase - -Dim MyDatabase As SQLDatabase -Dim MyRecordset As New SQLTestRecordset -Dim MyConnection As New SQLTestConnection -Dim SimpleInsert As SQLInsert -Dim TestCase As iTestCase - -' Constructor: Class_Initialize -' Initialize class members -Private Sub Class_Initialize() - Set TestCase = CreateTestCase() -End Sub - -Sub iTestCase_Setup() - Set MyDatabase = Create_SQLDatabase() - - With MyDatabase - .DSN = "mydsn" - .Password = "Pa$$word" - .Username = "myusername" - Set .Recordset = MyRecordset - Set .Connection = MyConnection - End With - - - Set SimpleInsert = Create_SQLInsert - With SimpleInsert - .Table = "users" - .Fields = Array("id") - .Values = Array(1) - End With -End Sub - -Sub iTestCase_TearDown() - -End Sub - -Function mssqlTest() - MyDatabase.DBType = "mssql" - - Actual = MyDatabase.InsertGetNewId(SimpleInsert) - Expected = "SET NOCOUNT ON;INSERT INTO users (id) VALUES (1);SELECT SCOPE_IDENTITY() as somethingunique" - mssqlTest = AssertEquals(Actual, Expected) -End Function - -Function psqlTest() - MyDatabase.DBType = "psql" - - Actual = MyDatabase.InsertGetNewId(SimpleInsert, "id") - Expected = "INSERT INTO users (id) VALUES (1) RETURNING id" - psqlTest = AssertEquals(Actual, Expected) - -End Function - -' Sub: iTestCase_RunTest -' Run a specific test. -Public Sub iTestCase_RunTest(Test As String, Optional clsObj = Nothing) - TestCase.RunTest Test, Me -End Sub - -' Sub: iTestCase_RunAllTests -' Run all tests. -Public Sub iTestCase_RunAllTests(Optional ByVal clsObj = Nothing) - TestCase.RunAllTests Me -End Sub +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "SQLlibDatabaseTests" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Implements iTestCase + +Dim MyDatabase As SQLDatabase +Dim MyRecordset As New SQLTestRecordset +Dim MyConnection As New SQLTestConnection +Dim SimpleInsert As SQLInsert +Dim TestCase As iTestCase + +' Constructor: Class_Initialize +' Initialize class members +Private Sub Class_Initialize() + Set TestCase = CreateTestCase() +End Sub + +Sub iTestCase_Setup() + Set MyDatabase = Create_SQLDatabase() + + With MyDatabase + .DSN = "mydsn" + .Password = "Pa$$word" + .Username = "myusername" + Set .Recordset = MyRecordset + Set .Connection = MyConnection + End With + + + Set SimpleInsert = Create_SQLInsert + With SimpleInsert + .Table = "users" + .Fields = Array("id") + .Values = Array(1) + End With +End Sub + +Sub iTestCase_TearDown() + +End Sub + +Function mssqlTest() + MyDatabase.DBType = "mssql" + + Actual = MyDatabase.InsertGetNewId(SimpleInsert) + Expected = "SET NOCOUNT ON;INSERT INTO users (id) VALUES (1);SELECT SCOPE_IDENTITY() as somethingunique" + mssqlTest = AssertEquals(Actual, Expected) +End Function + +Function psqlTest() + MyDatabase.DBType = "psql" + + Actual = MyDatabase.InsertGetNewId(SimpleInsert, "id") + Expected = "INSERT INTO users (id) VALUES (1) RETURNING id" + psqlTest = AssertEquals(Actual, Expected) + +End Function + +' Sub: iTestCase_RunTest +' Run a specific test. +Public Sub iTestCase_RunTest(Test As String, Optional clsObj = Nothing) + TestCase.RunTest Test, Me +End Sub + +' Sub: iTestCase_RunAllTests +' Run all tests. +Public Sub iTestCase_RunAllTests(Optional ByVal clsObj = Nothing) + TestCase.RunAllTests Me +End Sub diff --git a/testing/ClassModules/SQLlibDeleteTests.cls b/testing/ClassModules/SQLlibDeleteTests.cls index 6c1d9af..5702db8 100644 --- a/testing/ClassModules/SQLlibDeleteTests.cls +++ b/testing/ClassModules/SQLlibDeleteTests.cls @@ -1,53 +1,53 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "SQLlibDeleteTests" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = False -Implements iTestCase - -Dim TestCase As iTestCase - -' Constructor: Class_Initialize -' Initialize class members -Private Sub Class_Initialize() - Set TestCase = CreateTestCase() -End Sub - -Sub iTestCase_Setup() - -End Sub - -Sub iTestCase_TearDown() - -End Sub - -Function SimpleDeleteTest() - Dim MyDelete As SQLDelete - Dim Interfaced As iSQLQuery - Set MyDelete = Create_SQLDelete() - MyDelete.Table = "users" - - Set Interfaced = MyDelete - Result = Result And AssertObjectStringEquals(Interfaced, "DELETE FROM users") - - MyDelete.AddWhere "age", ":age", "<" - MyDelete.AddArgument ":age", 13 - - SimpleDeleteTest = AssertObjectStringEquals(Interfaced, "DELETE FROM users WHERE age<13") -End Function - -' Sub: iTestCase_RunTest -' Run a specific test. -Public Sub iTestCase_RunTest(Test As String, Optional clsObj = Nothing) - TestCase.RunTest Test, Me -End Sub - -' Sub: iTestCase_RunAllTests -' Run all tests. -Public Sub iTestCase_RunAllTests(Optional ByVal clsObj = Nothing) - TestCase.RunAllTests Me -End Sub +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "SQLlibDeleteTests" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Implements iTestCase + +Dim TestCase As iTestCase + +' Constructor: Class_Initialize +' Initialize class members +Private Sub Class_Initialize() + Set TestCase = CreateTestCase() +End Sub + +Sub iTestCase_Setup() + +End Sub + +Sub iTestCase_TearDown() + +End Sub + +Function SimpleDeleteTest() + Dim MyDelete As SQLDelete + Dim Interfaced As iSQLQuery + Set MyDelete = Create_SQLDelete() + MyDelete.Table = "users" + + Set Interfaced = MyDelete + Result = Result And AssertObjectStringEquals(Interfaced, "DELETE FROM users") + + MyDelete.AddWhere "age", ":age", "<" + MyDelete.AddArgument ":age", 13 + + SimpleDeleteTest = AssertObjectStringEquals(Interfaced, "DELETE FROM users WHERE age<13") +End Function + +' Sub: iTestCase_RunTest +' Run a specific test. +Public Sub iTestCase_RunTest(Test As String, Optional clsObj = Nothing) + TestCase.RunTest Test, Me +End Sub + +' Sub: iTestCase_RunAllTests +' Run all tests. +Public Sub iTestCase_RunAllTests(Optional ByVal clsObj = Nothing) + TestCase.RunAllTests Me +End Sub diff --git a/testing/ClassModules/SQLlibInsertTests.cls b/testing/ClassModules/SQLlibInsertTests.cls index d96aa18..0fb8322 100644 --- a/testing/ClassModules/SQLlibInsertTests.cls +++ b/testing/ClassModules/SQLlibInsertTests.cls @@ -1,86 +1,86 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "SQLlibInsertTests" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = False -Implements iTestCase - -Dim Interfaced As iSQLQuery -Dim MyInsert As SQLInsert -Dim TestCase As iTestCase - -' Constructor: Class_Initialize -' Initialize class members -Private Sub Class_Initialize() - Set TestCase = CreateTestCase() -End Sub - -Sub iTestCase_Setup() - Set MyInsert = Create_SQLInsert -End Sub - -Sub iTestCase_TearDown() - -End Sub - -Function SimpleInsertTest() - With MyInsert - .Table = "users" - .Fields = Array("name", "type") - .Values = Array("'foo'", "'admin'") - .Returning = "id" - End With - Set Interfaced = MyInsert - Expected = "INSERT INTO users (name, type) VALUES ('foo', 'admin') RETURNING id" - SimpleInsertTest = AssertEquals(Interfaced.toString, Expected) -End Function - -Function InsertSelectTest() - Dim MySelect As SQLSelect - Set MySelect = Create_SQLSelect - With MySelect - .Table = "account_types" - .Fields = Array("'foo'", "id") - .AddWhere "type", ":type" - .AddArgument ":type", "admin" - End With - With MyInsert - .Table = "users" - .Fields = Array("name", "type_id") - .Values = Array() - .Returning = "id" - Set .From = MySelect - End With - Set Interfaced = MyInsert - Expected = "INSERT INTO users (name, type_id) (SELECT 'foo', id FROM account_types WHERE type='admin') RETURNING id" - InsertSelectTest = AssertEquals(Interfaced.toString, Expected) -End Function - -Public Function InsertMultipleTest() - MyInsert.Table = "users" - MyInsert.Fields = Array("name", "type") - Dim Values(1) As Variant - - Values(0) = Array("'foo'", "'admin'") - Values(1) = Array("'bar'", "'editor'") - MyInsert.Values = Values - Set Interfaced = MyInsert - Expected = "INSERT INTO users (name, type) VALUES ('foo', 'admin'), ('bar', 'editor')" - InsertMultipleTest = AssertObjectStringEquals(Interfaced, Expected) -End Function - -' Sub: iTestCase_RunTest -' Run a specific test. -Public Sub iTestCase_RunTest(Test As String, Optional clsObj = Nothing) - TestCase.RunTest Test, Me -End Sub - -' Sub: iTestCase_RunAllTests -' Run all tests. -Public Sub iTestCase_RunAllTests(Optional ByVal clsObj = Nothing) - TestCase.RunAllTests Me -End Sub +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "SQLlibInsertTests" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Implements iTestCase + +Dim Interfaced As iSQLQuery +Dim MyInsert As SQLInsert +Dim TestCase As iTestCase + +' Constructor: Class_Initialize +' Initialize class members +Private Sub Class_Initialize() + Set TestCase = CreateTestCase() +End Sub + +Sub iTestCase_Setup() + Set MyInsert = Create_SQLInsert +End Sub + +Sub iTestCase_TearDown() + +End Sub + +Function SimpleInsertTest() + With MyInsert + .Table = "users" + .Fields = Array("name", "type") + .Values = Array("'foo'", "'admin'") + .Returning = "id" + End With + Set Interfaced = MyInsert + Expected = "INSERT INTO users (name, type) VALUES ('foo', 'admin') RETURNING id" + SimpleInsertTest = AssertEquals(Interfaced.toString, Expected) +End Function + +Function InsertSelectTest() + Dim MySelect As SQLSelect + Set MySelect = Create_SQLSelect + With MySelect + .Table = "account_types" + .Fields = Array("'foo'", "id") + .AddWhere "type", ":type" + .AddArgument ":type", "admin" + End With + With MyInsert + .Table = "users" + .Fields = Array("name", "type_id") + .Values = Array() + .Returning = "id" + Set .From = MySelect + End With + Set Interfaced = MyInsert + Expected = "INSERT INTO users (name, type_id) (SELECT 'foo', id FROM account_types WHERE type='admin') RETURNING id" + InsertSelectTest = AssertEquals(Interfaced.toString, Expected) +End Function + +Public Function InsertMultipleTest() + MyInsert.Table = "users" + MyInsert.Fields = Array("name", "type") + Dim Values(1) As Variant + + Values(0) = Array("'foo'", "'admin'") + Values(1) = Array("'bar'", "'editor'") + MyInsert.Values = Values + Set Interfaced = MyInsert + Expected = "INSERT INTO users (name, type) VALUES ('foo', 'admin'), ('bar', 'editor')" + InsertMultipleTest = AssertObjectStringEquals(Interfaced, Expected) +End Function + +' Sub: iTestCase_RunTest +' Run a specific test. +Public Sub iTestCase_RunTest(Test As String, Optional clsObj = Nothing) + TestCase.RunTest Test, Me +End Sub + +' Sub: iTestCase_RunAllTests +' Run all tests. +Public Sub iTestCase_RunAllTests(Optional ByVal clsObj = Nothing) + TestCase.RunAllTests Me +End Sub diff --git a/testing/ClassModules/SQLlibSelectTests.cls b/testing/ClassModules/SQLlibSelectTests.cls index 214f610..0eec308 100644 --- a/testing/ClassModules/SQLlibSelectTests.cls +++ b/testing/ClassModules/SQLlibSelectTests.cls @@ -1,106 +1,106 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "SQLlibSelectTests" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = False -Implements iTestCase - -Dim Interfaced As iSQLQuery -Dim TestCase As iTestCase - -' Constructor: Class_Initialize -' Initialize class members -Private Sub Class_Initialize() - Set TestCase = CreateTestCase() -End Sub - -Sub iTestCase_Setup() - -End Sub - -Sub iTestCase_TearDown() - -End Sub - -Function SimpleSelectTest() - - Set MySelect = Create_SQLSelect - MySelect.Table = "users" - MySelect.Fields = Array("id", "username") - MySelect.AddWhere "created", "'2000-01-01'", ">" - Set Interfaced = MySelect - Expected = "SELECT id, username FROM users WHERE created>'2000-01-01'" - Call AssertObjectStringEquals(Interfaced, Expected) - - MySelect.AddWhere "type", "'admin'" - Call AssertObjectStringEquals(Interfaced, "SELECT id, username FROM users WHERE created>'2000-01-01' AND type='admin'") - - MySelect.AddWhere "flag", "NULL", "IS", "OR" - Call AssertObjectStringEquals(Interfaced, "SELECT id, username FROM users WHERE (created>'2000-01-01' AND type='admin') OR flag IS NULL") -End Function - -Function GetByPropertyTest() - Dim MyOtherSelect As SQLSelect - Set MyOtherSelect = Create_SQLSelect - MyOtherSelect.getByProperty "users", "id", "name", ":name" - MyOtherSelect.AddArgument ":name", "admin" - Set Interfaced = MyOtherSelect - GetByPropertyTest = AssertObjectStringEquals(Interfaced, "SELECT id FROM users WHERE name='admin'") -End Function - -Function JoinTest() - 'Check Join - Set MySelect = Create_SQLSelect - With MySelect - .addTable "users", "u" - .InnerJoin "countries", "c", "u.country=c.country" - .Fields = Array("u.uname", "c.capital") - End With - Set Interfaced = MySelect - JoinTest = AssertObjectStringEquals(Interfaced, "SELECT u.uname, c.capital FROM users u INNER JOIN countries c ON u.country=c.country") - - MySelect.AddField "t.zone" - MySelect.InnerJoin "timezones", "t", "c.capital=t.city" - Call AssertObjectStringEquals(Interfaced, "SELECT u.uname, c.capital, t.zone FROM users u INNER JOIN countries c ON u.country=c.country INNER JOIN timezones t ON c.capital=t.city") -End Function - -Function DistinctTest() - 'Distinct - Set MySelect = Create_SQLSelect - With MySelect - .addTable "customers", "c" - .Fields = Array("c.country") - .Distinct - .OrderBy ("c.country") - End With - Set Interfaced = MySelect - DistinctTest = AssertObjectStringEquals(Interfaced, "SELECT DISTINCT c.country FROM customers c ORDER BY c.country ASC") -End Function - -Function MultipleTableTest() - 'Distinct - Set MySelect = Create_SQLSelect - With MySelect - .AddTable "countries", "c" - .AddTable "users", "u" - .Fields = Array("u.uname", "c.capital") - End With - Set Interfaced = MySelect - MultipleTableTest = AssertObjectStringEquals(Interfaced, "SELECT u.uname, c.capital FROM countries c, users u") -End Function - -' Sub: iTestCase_RunTest -' Run a specific test. -Public Sub iTestCase_RunTest(Test As String, Optional clsObj = Nothing) - TestCase.RunTest Test, Me -End Sub - -' Sub: iTestCase_RunAllTests -' Run all tests. -Public Sub iTestCase_RunAllTests(Optional ByVal clsObj = Nothing) - TestCase.RunAllTests Me -End Sub +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "SQLlibSelectTests" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Implements iTestCase + +Dim Interfaced As iSQLQuery +Dim TestCase As iTestCase + +' Constructor: Class_Initialize +' Initialize class members +Private Sub Class_Initialize() + Set TestCase = CreateTestCase() +End Sub + +Sub iTestCase_Setup() + +End Sub + +Sub iTestCase_TearDown() + +End Sub + +Function SimpleSelectTest() + + Set MySelect = Create_SQLSelect + MySelect.Table = "users" + MySelect.Fields = Array("id", "username") + MySelect.AddWhere "created", "'2000-01-01'", ">" + Set Interfaced = MySelect + Expected = "SELECT id, username FROM users WHERE created>'2000-01-01'" + Call AssertObjectStringEquals(Interfaced, Expected) + + MySelect.AddWhere "type", "'admin'" + Call AssertObjectStringEquals(Interfaced, "SELECT id, username FROM users WHERE created>'2000-01-01' AND type='admin'") + + MySelect.AddWhere "flag", "NULL", "IS", "OR" + Call AssertObjectStringEquals(Interfaced, "SELECT id, username FROM users WHERE (created>'2000-01-01' AND type='admin') OR flag IS NULL") +End Function + +Function GetByPropertyTest() + Dim MyOtherSelect As SQLSelect + Set MyOtherSelect = Create_SQLSelect + MyOtherSelect.getByProperty "users", "id", "name", ":name" + MyOtherSelect.AddArgument ":name", "admin" + Set Interfaced = MyOtherSelect + GetByPropertyTest = AssertObjectStringEquals(Interfaced, "SELECT id FROM users WHERE name='admin'") +End Function + +Function JoinTest() + 'Check Join + Set MySelect = Create_SQLSelect + With MySelect + .addTable "users", "u" + .InnerJoin "countries", "c", "u.country=c.country" + .Fields = Array("u.uname", "c.capital") + End With + Set Interfaced = MySelect + JoinTest = AssertObjectStringEquals(Interfaced, "SELECT u.uname, c.capital FROM users u INNER JOIN countries c ON u.country=c.country") + + MySelect.AddField "t.zone" + MySelect.InnerJoin "timezones", "t", "c.capital=t.city" + Call AssertObjectStringEquals(Interfaced, "SELECT u.uname, c.capital, t.zone FROM users u INNER JOIN countries c ON u.country=c.country INNER JOIN timezones t ON c.capital=t.city") +End Function + +Function DistinctTest() + 'Distinct + Set MySelect = Create_SQLSelect + With MySelect + .addTable "customers", "c" + .Fields = Array("c.country") + .Distinct + .OrderBy ("c.country") + End With + Set Interfaced = MySelect + DistinctTest = AssertObjectStringEquals(Interfaced, "SELECT DISTINCT c.country FROM customers c ORDER BY c.country ASC") +End Function + +Function MultipleTableTest() + 'Distinct + Set MySelect = Create_SQLSelect + With MySelect + .AddTable "countries", "c" + .AddTable "users", "u" + .Fields = Array("u.uname", "c.capital") + End With + Set Interfaced = MySelect + MultipleTableTest = AssertObjectStringEquals(Interfaced, "SELECT u.uname, c.capital FROM countries c, users u") +End Function + +' Sub: iTestCase_RunTest +' Run a specific test. +Public Sub iTestCase_RunTest(Test As String, Optional clsObj = Nothing) + TestCase.RunTest Test, Me +End Sub + +' Sub: iTestCase_RunAllTests +' Run all tests. +Public Sub iTestCase_RunAllTests(Optional ByVal clsObj = Nothing) + TestCase.RunAllTests Me +End Sub diff --git a/testing/ClassModules/SQLlibStaticTests.cls b/testing/ClassModules/SQLlibStaticTests.cls index b63e121..12f4400 100644 --- a/testing/ClassModules/SQLlibStaticTests.cls +++ b/testing/ClassModules/SQLlibStaticTests.cls @@ -1,104 +1,104 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "SQLlibStaticTests" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = False -Implements iTestCase - -Dim Interfaced As iSQLQuery -Dim MyStatic As SQLStaticQuery -Dim TestCase As iTestCase - -' Constructor: Class_Initialize -' Initialize class members -Private Sub Class_Initialize() - Set TestCase = CreateTestCase() -End Sub - -Sub iTestCase_Setup() - Set MyStatic = Create_SQLStaticQuery - Set Interfaced = MyStatic -End Sub - -Sub iTestCase_TearDown() - -End Sub - -Function NoArgumentTest() - MyStatic.Query = "DELETE FROM users" - NoArgumentTest = AssertObjectStringEquals(Interfaced, "DELETE FROM users") -End Function - -Function AddargumentMissingColonTest() - MyStatic.Query = "SELECT name FROM users WHERE id=:id" - MyStatic.AddArgument "id", 4 - AddargumentMissingColonTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id=:id") -End Function - -Function CorrectUseTest() - MyStatic.Query = "SELECT name FROM users WHERE id=:id" - MyStatic.AddArgument ":id", 4 - CorrectUseTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id=4") -End Function - -Function ChangeArgumentTest() - MyStatic.Query = "SELECT name FROM users WHERE id=:id" - MyStatic.AddArgument ":id", 4 - MyStatic.AddArgument ":id", 40 - ChangeArgumentTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id=40") -End Function - -Function EscapeTextTest() - MyStatic.Query = "SELECT name FROM users WHERE id=:id" - MyStatic.AddArgument ":id", "text" - EscapeTextTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id='text'") -End Function - -Function MultipleArgumentTest() - MyStatic.Query = "SELECT name FROM users WHERE id=:id AND type=:type" - MyStatic.AddArgument ":type", "admin" - MultipleArgumentTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id=:id AND type='admin'") -End Function - -Function ClearArgumentsTest() - MyStatic.Query = "SELECT name FROM users WHERE id=:id AND type=:type" - MyStatic.AddArgument ":type", "admin" - MyStatic.ClearArguments - MyStatic.AddArgument ":id", 4 - ClearArgumentsTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id=4 AND type=:type") - MyStatic.AddArgument ":type", "admin" - Call AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id=4 AND type='admin'") -End Function - -' Function: InsertArgumentInValueTest -' Ensure that argument replacement will not search within string literals and replace the substring -Function InsertArgumentInValueTest() - MyStatic.Query = "SELECT name FROM users WHERE id=:id AND type=:type" - MyStatic.AddArgument ":id", "4:type" - MyStatic.AddArgument ":type", ";DELETE FROM users;:id" - InsertArgumentInValueTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id='4:type' AND type=';DELETE FROM users;:id'") -End Function - -' Function: InsertArgumentInValueTest -' Ensure that argument replacement will not search within string literals and replace the substring -Function InsertArgumentInStringTest() - MyStatic.Query = "SELECT name FROM users WHERE id=:id AND type=':id'" - MyStatic.AddArgument ":id", "4" - InsertArgumentInStringTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id='4' AND type=':id'") -End Function - -' Sub: iTestCase_RunTest -' Run a specific test. -Public Sub iTestCase_RunTest(Test As String, Optional clsObj = Nothing) - TestCase.RunTest Test, Me -End Sub - -' Sub: iTestCase_RunAllTests -' Run all tests. -Public Sub iTestCase_RunAllTests(Optional ByVal clsObj = Nothing) - TestCase.RunAllTests Me -End Sub +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "SQLlibStaticTests" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Implements iTestCase + +Dim Interfaced As iSQLQuery +Dim MyStatic As SQLStaticQuery +Dim TestCase As iTestCase + +' Constructor: Class_Initialize +' Initialize class members +Private Sub Class_Initialize() + Set TestCase = CreateTestCase() +End Sub + +Sub iTestCase_Setup() + Set MyStatic = Create_SQLStaticQuery + Set Interfaced = MyStatic +End Sub + +Sub iTestCase_TearDown() + +End Sub + +Function NoArgumentTest() + MyStatic.Query = "DELETE FROM users" + NoArgumentTest = AssertObjectStringEquals(Interfaced, "DELETE FROM users") +End Function + +Function AddargumentMissingColonTest() + MyStatic.Query = "SELECT name FROM users WHERE id=:id" + MyStatic.AddArgument "id", 4 + AddargumentMissingColonTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id=:id") +End Function + +Function CorrectUseTest() + MyStatic.Query = "SELECT name FROM users WHERE id=:id" + MyStatic.AddArgument ":id", 4 + CorrectUseTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id=4") +End Function + +Function ChangeArgumentTest() + MyStatic.Query = "SELECT name FROM users WHERE id=:id" + MyStatic.AddArgument ":id", 4 + MyStatic.AddArgument ":id", 40 + ChangeArgumentTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id=40") +End Function + +Function EscapeTextTest() + MyStatic.Query = "SELECT name FROM users WHERE id=:id" + MyStatic.AddArgument ":id", "text" + EscapeTextTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id='text'") +End Function + +Function MultipleArgumentTest() + MyStatic.Query = "SELECT name FROM users WHERE id=:id AND type=:type" + MyStatic.AddArgument ":type", "admin" + MultipleArgumentTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id=:id AND type='admin'") +End Function + +Function ClearArgumentsTest() + MyStatic.Query = "SELECT name FROM users WHERE id=:id AND type=:type" + MyStatic.AddArgument ":type", "admin" + MyStatic.ClearArguments + MyStatic.AddArgument ":id", 4 + ClearArgumentsTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id=4 AND type=:type") + MyStatic.AddArgument ":type", "admin" + Call AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id=4 AND type='admin'") +End Function + +' Function: InsertArgumentInValueTest +' Ensure that argument replacement will not search within string literals and replace the substring +Function InsertArgumentInValueTest() + MyStatic.Query = "SELECT name FROM users WHERE id=:id AND type=:type" + MyStatic.AddArgument ":id", "4:type" + MyStatic.AddArgument ":type", ";DELETE FROM users;:id" + InsertArgumentInValueTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id='4:type' AND type=';DELETE FROM users;:id'") +End Function + +' Function: InsertArgumentInValueTest +' Ensure that argument replacement will not search within string literals and replace the substring +Function InsertArgumentInStringTest() + MyStatic.Query = "SELECT name FROM users WHERE id=:id AND type=':id'" + MyStatic.AddArgument ":id", "4" + InsertArgumentInStringTest = AssertObjectStringEquals(Interfaced, "SELECT name FROM users WHERE id='4' AND type=':id'") +End Function + +' Sub: iTestCase_RunTest +' Run a specific test. +Public Sub iTestCase_RunTest(Test As String, Optional clsObj = Nothing) + TestCase.RunTest Test, Me +End Sub + +' Sub: iTestCase_RunAllTests +' Run all tests. +Public Sub iTestCase_RunAllTests(Optional ByVal clsObj = Nothing) + TestCase.RunAllTests Me +End Sub diff --git a/testing/ClassModules/SQLlibTests.cls b/testing/ClassModules/SQLlibTests.cls new file mode 100644 index 0000000..d8a0369 --- /dev/null +++ b/testing/ClassModules/SQLlibTests.cls @@ -0,0 +1,56 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "SQLlibTests" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Implements iTestableProject + +Dim bOutputFailures As Boolean + +Dim TestRunner As TestRunner + +' Constructor: Class_Initialize +' Configure the test runner +Private Sub Class_Initialize() + ' Print each failure as it occurs + bOutputFailures = True +End Sub + +Public Property Get iTestableProject_GetOutputFailures() + iTestableProject_GetOutputFailures = bOutputFailures +End Property + +Public Function iTestableProject_GetTestCases() + iTestableProject_GetTestCases = Array(New SQLlibDatabaseTests, New SQLlibDeleteTests, New SQLlibInsertTests, New SQLlibSelectTests, New SQLlibStaticTests, New SQLlibUpdateTests) +End Function + +' Function: Run +' Perform all the actions. +Public Function iTestableProject_Run() + Configure + Run + Report +End Function + +Private Sub Configure() + Set TestRunner = CreateTestRunner() + + ' Pass this object to the runner so it has access to the necessary data + Set TestRunner.TestConfig = New SQLlibTests +End Sub + +Private Sub Run() + ' We want to run all Test Cases + TestRunner.TestAllCases +End Sub +Private Sub Report() + ' We want to see the summary report in a message box at the end + TestReporter.ResultsMsgBox + + ' We also want to see a list of all the failures + TestReporter.PrintFailureLog +End Sub diff --git a/testing/ClassModules/SQLlibUpdateTests.cls b/testing/ClassModules/SQLlibUpdateTests.cls index 9b6e659..662ad3b 100644 --- a/testing/ClassModules/SQLlibUpdateTests.cls +++ b/testing/ClassModules/SQLlibUpdateTests.cls @@ -1,52 +1,52 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "SQLlibUpdateTests" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = False -Implements iTestCase - -Dim TestCase As iTestCase - -' Constructor: Class_Initialize -' Initialize class members -Private Sub Class_Initialize() - Set TestCase = CreateTestCase() -End Sub - -Sub iTestCase_Setup() - -End Sub - -Sub iTestCase_TearDown() - -End Sub - -Function SimpleUpdateTest() - Dim MyUpdate As SQLUpdate - Dim Interfaced As iSQLQuery - Set MyUpdate = Create_SQLUpdate - With MyUpdate - .Table = "users" - .Fields = Array("username") - .Values = Array(str("admin' WHERE id=1;DROP TABLE users;")) - .AddWhere "id", 1 - End With - Set Interfaced = MyUpdate - SimpleUpdateTest = AssertObjectStringEquals(Interfaced, "UPDATE users SET username='admin'' WHERE id=1;DROP TABLE users;' WHERE id=1") -End Function - -' Sub: iTestCase_RunTest -' Run a specific test. -Public Sub iTestCase_RunTest(Test As String, Optional clsObj = Nothing) - TestCase.RunTest Test, Me -End Sub - -' Sub: iTestCase_RunAllTests -' Run all tests. -Public Sub iTestCase_RunAllTests(Optional ByVal clsObj = Nothing) - TestCase.RunAllTests Me -End Sub +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "SQLlibUpdateTests" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Implements iTestCase + +Dim TestCase As iTestCase + +' Constructor: Class_Initialize +' Initialize class members +Private Sub Class_Initialize() + Set TestCase = CreateTestCase() +End Sub + +Sub iTestCase_Setup() + +End Sub + +Sub iTestCase_TearDown() + +End Sub + +Function SimpleUpdateTest() + Dim MyUpdate As SQLUpdate + Dim Interfaced As iSQLQuery + Set MyUpdate = Create_SQLUpdate + With MyUpdate + .Table = "users" + .Fields = Array("username") + .Values = Array(str("admin' WHERE id=1;DROP TABLE users;")) + .AddWhere "id", 1 + End With + Set Interfaced = MyUpdate + SimpleUpdateTest = AssertObjectStringEquals(Interfaced, "UPDATE users SET username='admin'' WHERE id=1;DROP TABLE users;' WHERE id=1") +End Function + +' Sub: iTestCase_RunTest +' Run a specific test. +Public Sub iTestCase_RunTest(Test As String, Optional clsObj = Nothing) + TestCase.RunTest Test, Me +End Sub + +' Sub: iTestCase_RunAllTests +' Run all tests. +Public Sub iTestCase_RunAllTests(Optional ByVal clsObj = Nothing) + TestCase.RunAllTests Me +End Sub