fpc/packages/fcl-db/tests/testsqlscript.pas
2017-09-29 07:48:42 +00:00

921 lines
23 KiB
ObjectPascal

{
This file is part of the Free Pascal run time library.
Copyright (c) 2008 by the Free Pascal development team
FPCUnit SQLScript test.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit testsqlscript;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, testregistry, sqlscript, fpcunit;
type
{ TMyScript }
TMyScript = class (TCustomSQLScript)
private
FExcept: string;
FStatements : TStrings;
FDirectives : TStrings;
FCommits : integer;
protected
procedure ExecuteStatement (SQLStatement: TStrings; var StopExecution: Boolean); override;
procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); override;
procedure ExecuteCommit(CommitRetaining: boolean=true); override;
procedure DefaultDirectives; override;
public
constructor create (AnOwner: TComponent); override;
destructor destroy; override;
function StatementsExecuted : string;
function DirectivesExecuted : string;
property DoException : string read FExcept write FExcept;
property Aborted;
property Line;
property UseDollarString;
property dollarstrings;
property Directives;
property Defines;
property Script;
property Terminator;
property CommentsinSQL;
property UseSetTerm;
property UseCommit;
property UseDefines;
property OnException;
end;
{ TTestSQLScript }
TTestSQLScript = class (TTestCase)
private
Script : TMyScript;
exceptionstatement,
exceptionmessage : string;
UseContinue : boolean;
procedure Add (s :string);
procedure AssertStatDir (Statements, Directives : string);
procedure DoExecution;
procedure ExceptionHandler(Sender: TObject; Statement: TStrings; TheException: Exception; var Continue: boolean);
procedure TestDirectiveOnException3;
protected
procedure SetUp; override;
procedure TearDown; override;
published
procedure TestCreateDefaults;
procedure TestTerminator;
procedure TestTerminatorNoFinal;
procedure TestSetTerm;
procedure TestUseSetTerm;
procedure TestComments;
procedure TestUseComments;
procedure TestCommit;
procedure TestUseCommit;
procedure TestDefine;
procedure TestUndefine;
procedure TestUndef;
procedure TestIfdef1;
procedure TestIfdef2;
procedure TestIfndef1;
procedure TestIfndef2;
procedure TestElse1;
procedure TestElse2;
procedure TestEndif1;
procedure TestEndif2;
procedure TestUseDefines;
procedure TestTermInComment;
procedure TestTermInQuotes1;
procedure TestTermInQuotes2;
procedure TestCommentInComment;
procedure TestCommentInQuotes1;
procedure TestCommentInQuotes2;
Procedure TestDashDashComment;
procedure TestQuote1InComment;
procedure TestQuote2InComment;
procedure TestQuoteInQuotes1;
procedure TestQuoteInQuotes2;
procedure TestStatementStop;
procedure TestDirectiveStop;
procedure TestStatementExeception;
procedure TestDirectiveException;
procedure TestCommitException;
procedure TestStatementOnExeception1;
procedure TestStatementOnExeception2;
procedure TestDirectiveOnException1;
procedure TestDirectiveOnException2;
procedure TestCommitOnException1;
procedure TestCommitOnException2;
procedure TestUseDollarSign;
procedure TestUseDollarSign2;
procedure TestUseDollarSign3;
end;
{ TTestEventSQLScript }
TTestEventSQLScript = class (TTestCase)
private
Script : TEventSQLScript;
StopToSend : boolean;
Received : string;
notifycount : integer;
LastSender : TObject;
procedure Notify (Sender : TObject);
procedure NotifyStatement (Sender: TObject; SQL_Statement: TStrings; var StopExecution: Boolean);
procedure NotifyDirective (Sender: TObject; Directive, Argument: AnsiString; var StopExecution: Boolean);
protected
procedure SetUp; override;
procedure TearDown; override;
published
procedure TestStatement;
procedure TestStatementStop;
procedure TestDirective;
procedure TestDirectiveStop;
procedure TestCommit;
procedure TestBeforeExec;
procedure TestAfterExec;
end;
implementation
{ TMyScript }
procedure TMyScript.ExecuteStatement(SQLStatement: TStrings; var StopExecution: Boolean);
var s : string;
r : integer;
begin
if (SQLStatement.count = 1) and (compareText(SQLStatement[0],'END')=0) then
StopExecution := true;
s := '';
for r := 0 to SQLstatement.count-1 do
begin
if s <> '' then
s := s + ' ';
s := s + SQLStatement[r];
end;
FStatements.Add (s);
if DoException <> '' then
raise exception.create(DoException);
end;
procedure TMyScript.ExecuteDirective(Directive, Argument: String; var StopExecution: Boolean);
begin
if Directive = 'STOP' then
StopExecution := true;
if Argument = '' then
FDirectives.Add (Directive)
else
FDirectives.Add (format('%s(%s)', [Directive, Argument]));
if DoException <> '' then
raise exception.create(DoException);
end;
procedure TMyScript.ExecuteCommit(CommitRetaining: boolean=true);
begin
inc (FCommits);
if DoException <> '' then
raise exception.create(DoException);
end;
procedure TMyScript.DefaultDirectives;
begin
inherited DefaultDirectives;
directives.add ('STOP');
end;
constructor TMyScript.create (AnOwner: TComponent);
begin
inherited create (AnOwner);
FStatements := TStringlist.Create;
FDirectives := TStringlist.Create;
FCommits := 0;
DoException := '';
end;
destructor TMyScript.destroy;
begin
FStatements.Free;
FDirectives.Free;
inherited destroy;
end;
function TMyScript.StatementsExecuted: string;
begin
result := FStatements.Commatext;
end;
function TMyScript.DirectivesExecuted: string;
begin
result := FDirectives.Commatext;
end;
{ TTestSQLScript }
procedure TTestSQLScript.Add(s: string);
begin
Script.Script.Add (s);
end;
procedure TTestSQLScript.AssertStatDir(Statements, Directives: string);
begin
AssertEquals ('Executed Statements', Statements, script.StatementsExecuted);
AssertEquals ('Executed Directives', Directives, script.DirectivesExecuted);
end;
procedure TTestSQLScript.DoExecution;
begin
script.execute;
end;
procedure TTestSQLScript.ExceptionHandler(Sender: TObject; Statement: TStrings;
TheException: Exception; var Continue: boolean);
var r : integer;
s : string;
begin
Continue := UseContinue;
if Statement.count > 0 then
s := Statement[0];
for r := 1 to Statement.count-1 do
s := s + ',' + Statement[r];
exceptionstatement := s;
exceptionmessage := TheException.message;
end;
procedure TTestSQLScript.SetUp;
begin
inherited SetUp;
Script := TMyscript.Create (nil);
end;
procedure TTestSQLScript.TearDown;
begin
Script.Free;
inherited TearDown;
end;
procedure TTestSQLScript.TestCreateDefaults;
begin
with Script do
begin
AssertEquals ('Terminator', ';', Terminator);
AssertTrue ('UseCommit', UseCommit);
AssertTrue ('UseSetTerm', UseSetTerm);
AssertTrue ('UseDefines', UseDefines);
AssertTrue ('CommentsInSQL', CommentsInSQL);
AssertFalse ('Aborted', Aborted);
AssertEquals ('Line', 0, Line);
AssertEquals ('Defines', 0, Defines.count);
AssertEquals ('Directives', 12, Directives.count);
AssertTrue('Have SET TERM',Directives.IndexOf('SET TERM')<>-1);
AssertTrue('Have COMMIT WORK',Directives.IndexOf('COMMIT WORK')<>-1);
AssertTrue('Have COMMIT RETAIN',Directives.IndexOf('COMMIT RETAIN')<>-1);
AssertTrue('Have COMMIT',Directives.IndexOf('COMMIT')<>-1);
AssertTrue('Have #IFDEF',Directives.IndexOf('#IFDEF')<>-1);
AssertTrue('Have #IFNDEF',Directives.IndexOf('#IFNDEF')<>-1);
AssertTrue('Have #ELSE',Directives.IndexOf('#ELSE')<>-1);
AssertTrue('Have #ENDIF',Directives.IndexOf('#ENDIF')<>-1);
AssertTrue('Have #DEFINE',Directives.IndexOf('#DEFINE')<>-1);
AssertTrue('Have #UNDEF',Directives.IndexOf('#UNDEF')<>-1);
AssertTrue('Have #UNDEFINE',Directives.IndexOf('#UNDEFINE')<>-1);
// This is defined in our test class.
AssertTrue('Have STOP',Directives.IndexOf('STOP')<>-1);
end;
end;
procedure TTestSQLScript.TestTerminator;
begin
script.terminator := '!';
Add('doe!iets!');
Add('anders!');
script.execute;
AssertStatDir('doe,iets,anders', '');
end;
procedure TTestSQLScript.TestTerminatorNoFinal;
begin
script.terminator := '!';
Add('doe!iets!');
Add('anders');
script.execute;
AssertStatDir('doe,iets,anders', '');
end;
procedure TTestSQLScript.TestSetTerm;
begin
script.UseSetTerm:=true;
Add('SET TERM !;');
script.execute;
AssertEquals ('terminator', '!', script.terminator);
AssertStatDir('', '');
end;
procedure TTestSQLScript.TestUseSetTerm;
begin
script.UseSetTerm:=false;
Script.Directives.Add ('SET TERM');
Add('SET TERM !;');
script.execute;
AssertEquals ('terminator', ';', script.terminator);
AssertStatDir('', '"SET TERM(!)"');
end;
procedure TTestSQLScript.TestComments;
begin
script.CommentsInSQL := true;
Add('/* comment */');
Add('statement;');
script.execute;
AssertStatDir ('"/* comment */ statement"', '');
end;
procedure TTestSQLScript.TestUseComments;
begin
script.CommentsInSQL := false;
Add('/* comment */');
Add('statement;');
script.execute;
AssertStatDir ('statement', '');
end;
procedure TTestSQLScript.TestCommit;
begin
script.UseCommit := true;
Add('commit;');
script.execute;
AssertEquals ('Commits', 1, script.FCommits);
AssertStatDir ('', '');
end;
procedure TTestSQLScript.TestUseCommit;
begin
script.UseCommit := false;
with script.Directives do
Delete(IndexOf('COMMIT'));
Add('commit;');
script.execute;
AssertEquals ('Commits', 0, script.FCommits);
AssertStatDir ('commit', '');
end;
procedure TTestSQLScript.TestDefine;
begin
script.UseDefines := true;
Add ('#define iets;');
script.execute;
AssertStatDir ('', '');
AssertEquals ('Aantal defines', 1, script.defines.count);
AssertEquals ('Juiste define', 'iets', script.Defines[0]);
end;
procedure TTestSQLScript.TestUndefine;
begin
script.UseDefines := true;
script.defines.Add ('iets');
Add ('#undefine iets;');
script.execute;
AssertStatDir ('', '');
AssertEquals ('Aantal defines', 0, script.defines.count);
end;
procedure TTestSQLScript.TestUndef;
begin
script.UseDefines := true;
script.defines.Add ('iets');
Add ('#Undef iets;');
script.execute;
AssertStatDir ('', '');
AssertEquals ('Aantal defines', 0, script.defines.count);
end;
procedure TTestSQLScript.TestIfdef1;
begin
script.UseDefines := true;
script.defines.add ('iets');
Add('#ifdef iets;');
Add('doe iets;');
script.execute;
AssertStatDir('"doe iets"', '');
end;
procedure TTestSQLScript.TestIfdef2;
begin
script.UseDefines := true;
Add('#ifdef iets;');
Add('doe iets;');
script.execute;
AssertStatDir('', '');
end;
procedure TTestSQLScript.TestIfndef1;
begin
script.UseDefines := true;
Add('#ifndef iets;');
Add('doe iets;');
script.execute;
AssertStatDir('"doe iets"', '');
end;
procedure TTestSQLScript.TestIfndef2;
begin
script.UseDefines := true;
script.defines.add ('iets');
Add('#ifndef iets;');
Add('doe iets;');
script.execute;
AssertStatDir('', '');
end;
procedure TTestSQLScript.TestElse1;
begin
script.UseDefines := true;
script.defines.add ('iets');
Add('#ifdef iets;');
Add('doe iets;');
add('#else;');
add('anders;');
script.execute;
AssertStatDir('"doe iets"', '');
end;
procedure TTestSQLScript.TestElse2;
begin
script.UseDefines := true;
script.defines.add ('iets');
Add('#ifndef iets;');
Add('doe iets;');
add('#else;');
add('anders;');
script.execute;
AssertStatDir('anders', '');
end;
procedure TTestSQLScript.TestEndif1;
begin
script.UseDefines := true;
Add('#ifdef iets;');
Add('doe iets;');
add('#endif;');
add('anders;');
script.execute;
AssertStatDir('anders', '');
end;
procedure TTestSQLScript.TestEndif2;
begin
script.UseDefines := true;
Add('#ifndef iets;');
Add('doe iets;');
add('#endif;');
add('anders;');
script.execute;
AssertStatDir('"doe iets",anders', '');
end;
procedure TTestSQLScript.TestUseDefines;
begin
script.UseDefines := false;
Add('#ifndef iets;');
Add('doe iets;');
add('#endif;');
add('anders;');
script.execute;
AssertStatDir('"doe iets",anders', '#IFNDEF(iets),#ENDIF');
end;
procedure TTestSQLScript.TestTermInComment;
begin
script.CommentsInSQL := false;
Add('/* terminator ; */iets;');
script.execute;
AssertStatDir('iets', '');
end;
procedure TTestSQLScript.TestTermInQuotes1;
begin
script.CommentsInSQL := false;
Add('iets '';'';');
script.execute;
AssertStatDir('"iets '';''"', '');
end;
procedure TTestSQLScript.TestTermInQuotes2;
begin
script.CommentsInSQL := false;
Add('iets ";";');
script.execute;
AssertStatDir('"iets "";"""', '');
end;
procedure TTestSQLScript.TestCommentInComment;
begin
script.CommentsInSQL := false;
Add('/* meer /* */iets;');
script.execute;
AssertStatDir('iets', '');
end;
procedure TTestSQLScript.TestCommentInQuotes1;
begin
script.CommentsInSQL := false;
Add('iets ''/* meer */'';');
script.execute;
AssertStatDir('"iets ''/* meer */''"', '');
end;
procedure TTestSQLScript.TestCommentInQuotes2;
begin
script.CommentsInSQL := false;
Add('iets "/* meer */";');
script.execute;
AssertStatDir('"iets ""/* meer */"""', '');
end;
procedure TTestSQLScript.TestDashDashComment;
begin
script.CommentsInSQL := false;
Add('-- my comment');
Add('CREATE TABLE "tPatients" (');
Add(' "BloodGroup" character(2),');
Add(' CONSTRAINT "ck_tPatients_BloodGroup" CHECK (("BloodGroup" = ANY (ARRAY[''A''::bpchar, ''B''::bpchar, ''AB''::bpchar, ''0''::bpchar]))),');
Add(');');
script.execute;
AssertStatDir('"CREATE TABLE ""tPatients"" ( ""BloodGroup"" character(2), CONSTRAINT ""ck_tPatients_BloodGroup"" CHECK ((""BloodGroup"" = ANY (ARRAY[''A''::bpchar, ''B''::bpchar, ''AB''::bpchar, ''0''::bpchar]))), )"', '');
end;
procedure TTestSQLScript.TestQuote1InComment;
begin
script.CommentsInSQL := false;
Add('/* s''morgens */iets;');
script.execute;
AssertStatDir('iets', '');
end;
procedure TTestSQLScript.TestQuote2InComment;
begin
script.CommentsInSQL := false;
Add('/* s"morgens */iets;');
script.execute;
AssertStatDir('iets', '');
end;
procedure TTestSQLScript.TestQuoteInQuotes1;
begin
script.CommentsInSQL := false;
Add('iets ''s"morgens'';');
script.execute;
AssertStatDir('"iets ''s""morgens''"', '');
end;
procedure TTestSQLScript.TestQuoteInQuotes2;
begin
script.CommentsInSQL := false;
Add('iets "s''morgens";');
script.execute;
AssertStatDir('"iets ""s''morgens"""', '');
end;
procedure TTestSQLScript.TestStatementStop;
begin
Add('END;meer;');
script.execute;
AssertStatDir('END', '');
end;
procedure TTestSQLScript.TestDirectiveStop;
begin
Add('Stop;meer;');
script.execute;
AssertStatDir('', 'STOP');
end;
procedure TTestSQLScript.TestStatementExeception;
begin
Add('iets;');
script.DoException:='FOUT';
AssertException (exception, @DoExecution);
AssertStatDir('iets', '');
end;
procedure TTestSQLScript.TestDirectiveException;
begin
Add('iets;');
script.Directives.Add('IETS');
script.DoException := 'FOUT';
AssertException (exception, @DoExecution);
AssertStatDir('', 'IETS');
end;
procedure TTestSQLScript.TestCommitException;
begin
Add ('commit;');
script.DoException := 'FOUT';
AssertException (exception, @DoExecution);
AssertStatDir('', '');
AssertEquals ('Commit count', 1, Script.FCommits);
end;
procedure TTestSQLScript.TestStatementOnExeception1;
begin
UseContinue := true;
script.DoException := 'Fout';
Add ('foutief;');
script.OnException:=@ExceptionHandler;
Script.Execute;
AssertEquals ('exception message', 'Fout', exceptionmessage);
AssertEquals ('exception statement', 'foutief', exceptionstatement);
end;
procedure TTestSQLScript.TestStatementOnExeception2;
begin
UseContinue := false;
script.DoException := 'Fout';
Add ('foutief;');
script.OnException:=@ExceptionHandler;
AssertException (exception, @DoExecution);
AssertEquals ('exception message', 'Fout', exceptionmessage);
AssertEquals ('exception statement', 'foutief', exceptionstatement);
end;
procedure TTestSQLScript.TestDirectiveOnException1;
begin
UseContinue := true;
script.DoException := 'Fout';
Add ('foutief;');
Script.Directives.Add ('FOUTIEF');
script.OnException:=@ExceptionHandler;
Script.Execute;
AssertEquals ('exception message', 'Fout', exceptionmessage);
AssertEquals ('exception statement', 'FOUTIEF', exceptionstatement);
end;
procedure TTestSQLScript.TestDirectiveOnException2;
begin
UseContinue := False;
script.DoException := 'Fout';
Add ('foutief;');
Script.Directives.Add ('FOUTIEF');
script.OnException:=@ExceptionHandler;
AssertException (exception, @DoExecution);
AssertEquals ('exception message', 'Fout', exceptionmessage);
AssertEquals ('exception statement', 'FOUTIEF', exceptionstatement);
end;
procedure TTestSQLScript.TestDirectiveOnException3;
begin
UseContinue := true;
script.DoException := 'Fout';
Add ('foutief probleem;');
Script.Directives.Add ('FOUTIEF');
script.OnException:=@ExceptionHandler;
Script.Execute;
AssertEquals ('exception message', 'Fout', exceptionmessage);
AssertEquals ('exception statement', 'FOUTIEF,probleem', exceptionstatement);
end;
procedure TTestSQLScript.TestCommitOnException1;
begin
UseContinue := true;
script.DoException := 'Fout';
Add ('Commit;');
script.OnException:=@ExceptionHandler;
Script.Execute;
AssertEquals ('exception message', 'Fout', exceptionmessage);
AssertEquals ('exception statement', 'COMMIT', exceptionstatement);
AssertEquals ('commit count', 1, Script.FCommits);
end;
procedure TTestSQLScript.TestCommitOnException2;
begin
UseContinue := false;
script.DoException := 'Fout';
Add ('Commit;');
script.OnException:=@ExceptionHandler;
AssertException (exception, @DoExecution);
AssertEquals ('exception message', 'Fout', exceptionmessage);
AssertEquals ('exception statement', 'COMMIT', exceptionstatement);
AssertEquals ('commit count', 1, Script.FCommits);
end;
Const
PLSQL1 = 'CREATE or replace FUNCTION test_double_bad_sum ( value1 int, value2 int ) '+
'RETURNS int AS $$ '+
'DECLARE '+
' TheDoubleSum int; '+
'BEGIN '+
' -- Start '+
' TheDoubleSum := value1; '+
' /* sum '+
' number '+
' 1 */ '+
' TheDoubleSum := TheDoubleSum + value2; '+
' TheDoubleSum := TheDoubleSum + value2; -- Sum number 2 '+
' return TheDoubleSum; '+
'END; '+
'$$ '+
'LANGUAGE plpgsql';
PLSQL2 = 'COMMENT ON FUNCTION test_double_bad_sum(IN integer, IN integer) '+
' IS ''Just a '+
' test function '+
' !!!''';
PLSQL3 = 'CREATE or replace FUNCTION test_double_bad_sum ( value1 int, value2 int ) '+
'RETURNS int AS $BOB$ '+
'DECLARE '+
' TheDoubleSum int; '+
'BEGIN '+
' -- Start '+
' TheDoubleSum := value1; '+
' /* sum '+
' number '+
' 1 */ '+
' TheDoubleSum := TheDoubleSum + value2; '+
' TheDoubleSum := TheDoubleSum + value2; -- Sum number 2 '+
' return TheDoubleSum; '+
'END; '+
'$BOB$ '+
'LANGUAGE plpgsql';
procedure TTestSQLScript.TestUseDollarSign;
begin
script.UseDollarString:=True;
Add(PLSQL1+';');
script.execute;
// Double quotes because there are spaces.
AssertStatDir('"'+plsql1+'"', '');
end;
procedure TTestSQLScript.TestUseDollarSign2;
begin
script.UseDollarString:=True;
Add(PLSQL1+';');
Add(PLSQL2+';');
script.execute;
// Double quotes because there are spaces.
AssertStatDir('"'+plsql1+'","'+PLSQL2+'"', '');
end;
procedure TTestSQLScript.TestUseDollarSign3;
begin
script.UseDollarString:=True;
script.DollarStrings.Add('BOB');
Add(PLSQL3+';');
script.execute;
// Double quotes because there are spaces.
AssertStatDir('"'+plsql3+'"', '');
end;
{ TTestEventSQLScript }
procedure TTestEventSQLScript.Notify(Sender: TObject);
begin
inc (NotifyCount);
LastSender := Sender;
end;
procedure TTestEventSQLScript.NotifyStatement(Sender: TObject;
SQL_Statement: TStrings; var StopExecution: Boolean);
var r : integer;
s : string;
begin
StopExecution := StopToSend;
if SQL_Statement.count > 0 then
begin
s := SQL_Statement[0];
for r := 1 to SQL_Statement.count-1 do
s := s + ';' + SQL_Statement[r];
if SQL_Statement.count > 1 then
s := '"' + s + '"';
end
else
s := '';
if received <> '' then
received := received + ';' + s
else
received := s;
LastSender := Sender;
end;
procedure TTestEventSQLScript.NotifyDirective(Sender: TObject; Directive,
Argument: AnsiString; var StopExecution: Boolean);
var s : string;
begin
StopExecution := StopToSend;
if Argument = '' then
s := Directive
else
s := format ('%s(%s)', [Directive, Argument]);
if received <> '' then
received := received + ';' + s
else
received := s;
LastSender := Sender;
end;
procedure TTestEventSQLScript.SetUp;
begin
inherited SetUp;
Script := TEventSQLScript.Create (nil);
notifycount := 0;
Received := '';
LastSender := nil;
end;
procedure TTestEventSQLScript.TearDown;
begin
Script.Free;
inherited TearDown;
end;
procedure TTestEventSQLScript.TestStatement;
begin
StopToSend:=false;
Script.OnSQLStatement := @NotifyStatement;
Script.Script.Text := 'stat1;stat2;';
script.execute;
AssertEquals ('Received', 'stat1;stat2', received);
AssertSame ('Sender', script, LastSender);
end;
procedure TTestEventSQLScript.TestStatementStop;
begin
StopToSend:=true;
Script.OnSQLStatement := @NotifyStatement;
Script.Script.Text := 'stat1;stat2;';
script.execute;
AssertEquals ('Received', 'stat1', received);
AssertSame ('Sender', script, LastSender);
end;
procedure TTestEventSQLScript.TestDirective;
begin
StopToSend:=false;
Script.OnSQLStatement := @NotifyStatement;
Script.OnDirective := @NotifyDirective;
script.Directives.Add ('STAT1');
Script.Script.Text := 'stat1 ik;stat2;';
script.execute;
AssertEquals ('Received', 'STAT1(ik);stat2', received);
AssertSame ('Sender', script, LastSender);
end;
procedure TTestEventSQLScript.TestDirectiveStop;
begin
StopToSend:=true;
Script.OnSQLStatement := @NotifyStatement;
Script.OnDirective := @NotifyDirective;
script.Directives.Add ('STAT1');
Script.Script.Text := 'stat1 ik;stat2;';
script.execute;
AssertEquals ('Received', 'STAT1(ik)', received);
AssertSame ('Sender', script, LastSender);
end;
procedure TTestEventSQLScript.TestCommit;
begin
Script.OnCommit := @Notify;
Script.Script.Text := 'iets; commit; anders;';
script.execute;
AssertEquals ('NotifyCount', 1, NotifyCount);
AssertSame ('Sender', script, LastSender);
end;
procedure TTestEventSQLScript.TestBeforeExec;
begin
Script.BeforeExecute := @Notify;
Script.Script.Text := 'update iets; anders iets;';
script.execute;
AssertEquals ('NotifyCount', 1, NotifyCount);
AssertSame ('Sender', script, LastSender);
end;
procedure TTestEventSQLScript.TestAfterExec;
begin
Script.AfterExecute := @Notify;
Script.Script.Text := 'update iets; anders iets; en meer;';
script.execute;
AssertEquals ('NotifyCount', 1, NotifyCount);
AssertSame ('Sender', script, LastSender);
end;
initialization
RegisterTests ([TTestSQLScript, TTestEventSQLScript]);
end.