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