sql parser: support CASE with selector (CASE A WHEN 1 THEN B ELSE C END)

git-svn-id: trunk@46489 -
(cherry picked from commit 809db09169a8d95117fb9a3db4e63d62823a99aa)

packages/fcl-db/src/sql/fpsqlparser.pas

@@ -1363,6 +1363,8 @@ begin
   Consume(tsqlCASE);
   Result:=TSQLCaseExpression(CreateElement(TSQLCaseExpression,AParent));
   try
+    if CurrentToken<>tsqlWhen then // case A when 1 the 2 when 3 then 4 else 5
+      Result.Selector:=ParseExprLevel1(AParent,[eoIF]);
     while CurrentToken=tsqlWhen do
       begin
       GetNextToken;

packages/fcl-db/src/sql/fpsqltree.pp

@@ -1469,6 +1469,7 @@ Type
 
   TSQLCaseExpression = Class(TSQLExpression)
   private
+    FSelector: TSQLExpression;
     FBranches: array of TSQLCaseExpressionBranch;
     FElseBranch: TSQLExpression;
     function GetBranch(Index: Integer): TSQLCaseExpressionBranch;
@@ -1477,6 +1478,7 @@ Type
     Destructor Destroy; override;
     Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
 
+    Property Selector: TSQLExpression Read FSelector Write FSelector;
     Property BranchCount: Integer Read GetBranchCount;
     Procedure AddBranch(ABranch: TSQLCaseExpressionBranch);
     Procedure ClearBranches;
@@ -2137,6 +2139,7 @@ destructor TSQLCaseExpression.Destroy;
 begin
   ClearBranches;
   FreeAndNil(FElseBranch);
+  FreeAndNil(FSelector);
   inherited Destroy;
 end;
 
@@ -2145,6 +2148,8 @@ var
   B: TSQLCaseExpressionBranch;
 begin
   Result:=SQLKeyWord('CASE',Options)+' ';
+  if Assigned(Selector) then
+    Result:=Result+Selector.GetAsSQL(Options,AIndent)+' ';
   for B in FBranches do
     Result:=Result+
       SQLKeyWord('WHEN ',Options)+B.Condition.GetAsSQL(Options, AIndent)+' '+

packages/fcl-db/tests/tcparser.pas

@@ -231,6 +231,7 @@ type
     procedure TestOr;
     procedure TestNotOr;
     procedure TestCase;
+    procedure TestCaseWithSelector;
     procedure TestAdd;
     procedure TestSubtract;
     procedure TestMultiply;
@@ -2268,6 +2269,36 @@ begin
   AssertEquals('ELSE result is "c"', 'c', R.Name);
 end;
 
+procedure TTestCheckParser.TestCaseWithSelector;
+
+Var
+  T : TSQLCaseExpression;
+  L : TSQLLiteralExpression;
+  R : TSQLIdentifierName;
+
+begin
+  T:=TSQLCaseExpression(TestCheck('CASE A WHEN 1 THEN "a" WHEN 2 THEN "b" ELSE "c" END',TSQLCaseExpression));
+  AssertNotNull('Selector exists',T.Selector);
+  AssertEquals('Branch count = 2',2,T.BranchCount);
+  AssertNotNull('Else branch exists',T.ElseBranch);
+
+  R:=(T.Selector as TSQLIdentifierExpression).Identifier;
+  AssertEquals('Selector identifier is "A"', 'A', R.Name);
+
+  L:=(T.Branches[0].Condition as TSQLLiteralExpression);
+  R:=(T.Branches[0].Expression as TSQLIdentifierExpression).Identifier;
+  AssertEquals('First WHEN Number is 1', 1, (L.Literal as TSQLIntegerLiteral).Value);
+  AssertEquals('First THEN result is "a"', 'a', R.Name);
+
+  L:=(T.Branches[1].Condition as TSQLLiteralExpression);
+  R:=(T.Branches[1].Expression as TSQLIdentifierExpression).Identifier;
+  AssertEquals('Second WHEN Number is 2', 2, (L.Literal as TSQLIntegerLiteral).Value);
+  AssertEquals('Second THEN result is "b"', 'b', R.Name);
+
+  R:=(T.ElseBranch as TSQLIdentifierExpression).Identifier;
+  AssertEquals('ELSE result is "c"', 'c', R.Name);
+end;
+
 procedure TTestCheckParser.TestNotBetween;
 
 Var