paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-23 13:01:45 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fcl-db: sql parser:

Browse Source 
- simplify code, thanks Michael & Laco. 
  - Tests for STARTING WITH
  - Work in progress on SET TERM+CREATE PROCEDURE test

git-svn-id: trunk@27915 -
This commit is contained in:
reiniero 2014-06-10 05:27:56 +00:00
parent c7a045af49
commit ebb2f38e08
2 changed files with 67 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
packages/fcl-db/src/sql/fpsqlparser.pas
View File

@ -2219,15 +2219,9 @@ begin
if Not (tt in sqlInvertableComparisons) then if Not (tt in sqlInvertableComparisons) then
Error(SErrUnexpectedToken,[CurrentTokenString]); Error(SErrUnexpectedToken,[CurrentTokenString]);
GetNextToken; GetNextToken;
// Step past expected STARTING WITH
If (tt=tsqlStarting) and (CurrentToken=tsqlWith) then
GetNextToken;
end end
else else
begin begin
// Step past expected STARTING WITH
If (tt=tsqlStarting) and (CurrentToken=tsqlWith) then
GetNextToken;
if (CurrentToken=tsqlNot) then if (CurrentToken=tsqlNot) then
begin begin
GetNextToken; GetNextToken;
@ -2237,6 +2231,10 @@ begin
end; end;
end; end;
// Step past expected STARTING WITH
If (tt=tsqlStarting) and (CurrentToken=tsqlWith) then
GetNextToken;
bw:=False; bw:=False;
doin:=false; doin:=false;
B:=nil; //needed for test later B:=nil; //needed for test later

66
packages/fcl-db/tests/tcparser.pas
View File

@ -207,6 +207,8 @@ type
procedure TestNotContaining; procedure TestNotContaining;
procedure TestStarting; procedure TestStarting;
procedure TestNotStarting; procedure TestNotStarting;
procedure TestStartingWith;
procedure TestNotStartingWith;
procedure TestBetween; procedure TestBetween;
procedure TestNotBetween; procedure TestNotBetween;
procedure TestLikeEscape; procedure TestLikeEscape;
@ -849,6 +851,7 @@ type
procedure TestSetTerm; procedure TestSetTerm;
procedure TestSetTermSemicolon; procedure TestSetTermSemicolon;
procedure TestSetTermCreateProcedure; procedure TestSetTermCreateProcedure;
procedure TestSetTermCreateProcedureVar;
end; end;
{ TTestGlobalParser } { TTestGlobalParser }
@ -915,6 +918,35 @@ begin
FToFree:=Parser.Parse; FToFree:=Parser.Parse;
end; end;
procedure TTestTermParser.TestSetTermCreateProcedureVar;
// Procedure with variable
Const
SQL =
'SET TERM ^ ;'+#13+#10+
'CREATE PROCEDURE PROCWITHVAR'+#13+#10+
'RETURNS (LANGUAGES VARCHAR(15) CHARACTER SET NONE)'+#13+#10+
'AS'+#13+#10+
'DECLARE VARIABLE i INTEGER;'+#13+#10+
'BEGIN'+#13+#10+
' i = 1;'+#13+#10+
' WHILE (i <= 5) DO'+#13+#10+
' BEGIN'+#13+#10+
' SELECT language_req[:i] FROM job'+#13+#10+
' INTO :languages;'+#13+#10+
' i = i +1;'+#13+#10+
' SUSPEND;'+#13+#10+
' END'+#13+#10+
'END ^'+#13+#10+
'SET TERM ; ^';
Var
S : TSQLSetTermStatement;
begin
CreateParser(SQL);
FToFree:=Parser.Parse;
end;
{ TTestGlobalParser } { TTestGlobalParser }
@ -2138,7 +2170,7 @@ Var
begin begin
B:=TSQLBinaryExpression(TestCheck('VALUE STARTING ''3''',TSQLBinaryExpression)); B:=TSQLBinaryExpression(TestCheck('VALUE STARTING ''3''',TSQLBinaryExpression));
AssertEquals('Like operator',boStarting,B.Operation); AssertEquals('Starting operator',boStarting,B.Operation);
AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral); AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
AssertLiteralExpr('Right is string',B.Right,TSQLStringLiteral); AssertLiteralExpr('Right is string',B.Right,TSQLStringLiteral);
end; end;
@ -2150,14 +2182,42 @@ Var
U : TSQLUnaryExpression; U : TSQLUnaryExpression;
begin begin
U:=TSQLUnaryExpression(TestCheck('VALUE NOT STARTING ''3''',TSQLUnaryExpression)); U:=TSQLUnaryExpression(TestCheck('VALUE NOT STARTING ''3''',TSQLUnaryExpression));
AssertEquals('Like operator',uoNot,U.Operation); AssertEquals('Not operator',uoNot,U.Operation);
CheckClass(U.Operand,TSQLBinaryExpression); CheckClass(U.Operand,TSQLBinaryExpression);
B:=TSQLBinaryExpression(U.Operand); B:=TSQLBinaryExpression(U.Operand);
AssertEquals('Like operator',boStarting,B.Operation); AssertEquals('Starting operator',boStarting,B.Operation);
AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral); AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
AssertLiteralExpr('Right is string',B.Right,TSQLStringLiteral); AssertLiteralExpr('Right is string',B.Right,TSQLStringLiteral);
end; end;
procedure TTestCheckParser.TestStartingWith;
Var
B : TSQLBinaryExpression;
begin
B:=TSQLBinaryExpression(TestCheck('VALUE STARTING WITH ''3''',TSQLBinaryExpression));
AssertEquals('Starting operator',boStarting,B.Operation);
AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
AssertLiteralExpr('Right is string',B.Right,TSQLStringLiteral);
end;
procedure TTestCheckParser.TestNotStartingWith;
Var
B : TSQLBinaryExpression;
U : TSQLUnaryExpression;
begin
U:=TSQLUnaryExpression(TestCheck('VALUE NOT STARTING WITH ''3''',TSQLUnaryExpression));
AssertEquals('Not operator',uoNot,U.Operation);
CheckClass(U.Operand,TSQLBinaryExpression);
B:=TSQLBinaryExpression(U.Operand);
AssertEquals('Starting operator',boStarting,B.Operation);
AssertLiteralExpr('Left is value',B.Left,TSQLValueLiteral);
AssertLiteralExpr('Right is string',B.Right,TSQLStringLiteral);
end;
procedure TTestCheckParser.TestBetween; procedure TTestCheckParser.TestBetween;
Var Var