123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920 |
- {
- 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.
|