fcl-db: parse FOR UPDATE OF column1, ... and WITH LOCK

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

@@ -141,6 +141,7 @@ Type
     procedure ParseLimit(AParent: TSQLSelectStatement; ALimit: TSQLSelectLimit);
     procedure ParseSelectFieldList(AParent: TSQLSelectStatement; AList: TSQLElementList; Singleton : Boolean);
     function ParseForUpdate(AParent: TSQLSelectStatement): TSQLElementList;
+    procedure ParseWithLock(AParent: TSQLSelectStatement);
     function ParseSelectPlan(AParent: TSQLElement): TSQLSelectPlan;
     function ParseTableRef(AParent: TSQLSelectStatement): TSQLTableReference;
     procedure ParseIntoList(AParent: TSQLElement; List: TSQLElementList);
@@ -560,21 +561,47 @@ function TSQLParser.ParseForUpdate(AParent: TSQLSelectStatement
 
 begin
   // On entry we're on the FOR token.
+  // FOR UPDATE
+  // FOR UPDATE NOWAIT
+  // FOR UPDATE OF column1, ...  (Firebird)
   Consume(tsqlFor);
   Expect(tsqlUpdate);
   Result:=TSQLElementList.Create(True);
   try
-    Repeat
-      GetNextToken;
-      Expect(tsqlIdentifier);
-      Result.Add(CreateIdentifier(AParent,CurrentTokenString));
-    until (CurrentToken<>tsqlComma);
+    GetNextToken;
+    if CurrentToken=tsqlIdentifier then
+      begin
+      if SameText(CurrentTokenString,'NOWAIT') then
+        begin
+          AParent.ForUpdateNoWait:=true;
+          GetNextToken;
+        end;
+      if SameText(CurrentTokenString,'OF') then
+        begin
+          Repeat
+            GetNextToken;
+            Expect(tsqlIdentifier);
+            Result.Add(CreateIdentifier(AParent,CurrentTokenString));
+            GetNextToken;
+          until (CurrentToken<>tsqlComma);
+        end;
+      end;
   except
     FreeAndNil(Result);
     Raise;
   end;
 end;
 
+procedure TSQLParser.ParseWithLock(AParent: TSQLSelectStatement);
+begin
+  // On entry we're on the WITH token.
+  AParent.WithLock:=true;
+  GetNextToken;
+  If (CurrentToken<>tsqlIdentifier) or not SameText(CurrentTokenString,'LOCK') then
+    Error(SerrTokenMismatch,[CurrentTokenString,'LOCK']);
+  GetNextToken;
+end;
+
 procedure TSQLParser.ParseOrderBy(AParent: TSQLSelectStatement;
   AList: TSQLElementList);
 
@@ -805,6 +832,8 @@ begin
         ParseLimit(Result,Result.Limit);
       if (CurrentToken=tsqlFOR) then
         Result.ForUpdate:=ParseForUpdate(Result);
+      if (CurrentToken=tsqlWITH) and not Result.HasAncestor(TSQLCreateViewStatement) then
+        ParseWithLock(Result);
       end;
     if (sfInto in Flags) then
        begin
@@ -1444,6 +1473,7 @@ procedure TSQLParser.ParseLimit(AParent: TSQLSelectStatement; ALimit: TSQLSelect
       end;
   end;
 begin
+  if AParent=nil then ;
   ALimit.Style:=lsPostgres;
   if CurrentToken=tsqlLIMIT then
     begin
@@ -3309,6 +3339,7 @@ function TSQLParser.ParseCreateDatabaseStatement(AParent: TSQLElement; IsAlter:
 
 begin
   // On entry, we're on the DATABASE or SCHEMA token
+  if IsAlter then ;
   Result:=TSQLCreateDatabaseStatement(CreateElement(TSQLCreateDatabaseStatement,AParent));
   try
     Result.UseSchema:=(CurrentToken=tsqlSchema);
@@ -3417,6 +3448,7 @@ function TSQLParser.ParseAlterDatabaseStatement(AParent: TSQLElement;
   IsAlter: Boolean): TSQLAlterDatabaseStatement;
 begin
   // On entry, we're on the DATABASE or SCHEMA token.
+  if IsAlter then ;
   Result:=TSQLAlterDatabaseStatement(CreateElement(TSQLAlterDatabaseStatement,APArent));
   try
     Result.UseSchema:=CurrentToken=tsqlSchema;
@@ -3435,7 +3467,6 @@ begin
     FreeAndNil(Result);
     Raise;
   end;
-
 end;
 
 function TSQLParser.ParseCreateStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
@@ -4222,7 +4253,7 @@ begin
     Result:=ParseScript([])
 end;
 
-Function TSQLParser.ParseScript(aOptions : TParserOptions = []) : TSQLElementList;
+function TSQLParser.ParseScript(aOptions: TParserOptions): TSQLElementList;
 
 var
   E : TSQLElement;

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

@@ -87,6 +87,7 @@ Type
     Constructor Create(AParent : TSQLElement); virtual;
     destructor destroy; override;
     function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; virtual; abstract;
+    function HasAncestor(aClass: TClass): boolean;
     Property Parent: TSQLElement Read FParent;
     Property Source : String Read FSource write FSource;
     Property SourceLine : Integer Read Fline Write Fline;
@@ -801,6 +802,7 @@ Type
   TSQLSelectStatement = Class(TSQLDMLStatement)
   private
     FAll: Boolean;
+    FForUpdateNoWait: boolean;
     FLimit: TSQLSelectLimit;
     FDistinct: Boolean;
     FEndAt: TSQLExpression;
@@ -817,6 +819,7 @@ Type
     FUnion: TSQLSelectStatement;
     FUnionAll: Boolean;
     FWhere: TSQLExpression;
+    FWithLock: boolean;
   Public
     Constructor Create(AParent : TSQLElement); override;
     Destructor Destroy; override;
@@ -829,6 +832,7 @@ Type
     Property Having : TSQLExpression Read FHaving Write FHaving;
     Property Orderby : TSQLElementList Read FOrderBy;
     Property ForUpdate : TSQLElementList Read FForUpdate Write FForUpdate;
+    Property ForUpdateNoWait : boolean Read FForUpdateNoWait Write FForUpdateNoWait;
     Property Union : TSQLSelectStatement Read FUnion Write FUnion;
     Property Plan : TSQLSelectPlan Read FPlan Write FPlan;
     Property Limit: TSQLSelectLimit Read FLimit;
@@ -838,6 +842,7 @@ Type
     property StartAt : TSQLExpression Read FStartAt Write FStartAt;
     Property EndAt : TSQLExpression Read FEndAt Write FEndAt;
     Property Into : TSQLElementList Read FInto Write FInto;
+    Property WithLock: boolean Read FWithLock Write FWithLock;
   end;
 
   { TSQLInsertStatement }
@@ -2257,6 +2262,18 @@ begin
   inherited destroy;
 end;
 
+function TSQLElement.HasAncestor(aClass: TClass): boolean;
+var
+  El: TSQLElement;
+begin
+  El:=Parent;
+  while El<>nil do begin
+    if El.InheritsFrom(aClass) then exit(true);
+    El:=El.Parent;
+  end;
+  Result:=false;
+end;
+
 { TSQLSelectStatement }
 
 constructor TSQLSelectStatement.Create(AParent: TSQLElement);

packages/fcl-db/tests/tcparser.pas

@@ -500,6 +500,10 @@ type
     procedure TestParamExpr;
     procedure TestNoTable;
     procedure TestSourcePosition;
+    procedure TestForUpdate;
+    procedure TestForUpdateNowait;
+    procedure TestForUpdateOf;
+    procedure TestWithLock;
   end;
 
   { TTestRollBackParser }
@@ -4205,6 +4209,36 @@ begin
   AssertEquals('Table source position = 6', 6, Select.Tables[0].SourcePos);
 end;
 
+procedure TTestSelectParser.TestForUpdate;
+begin
+  TestSelect('SELECT B FROM A FOR UPDATE');
+  AssertEquals('FOR UPDATE',Select.ForUpdate<>nil,true);
+  AssertEquals('FOR UPDATE list count',Select.ForUpdate.Count,0);
+end;
+
+procedure TTestSelectParser.TestForUpdateNowait;
+begin
+  TestSelect('SELECT B FROM A FOR UPDATE NOWAIT');
+  AssertEquals('FOR UPDATE',Select.ForUpdate<>nil,true);
+  AssertEquals('FOR UPDATE list count',Select.ForUpdate.Count,0);
+  AssertEquals('FOR UPDATE',Select.ForUpdateNoWait,true);
+end;
+
+procedure TTestSelectParser.TestForUpdateOf;
+begin
+  TestSelect('SELECT * FROM A FOR UPDATE OF B,C');
+  AssertEquals('FOR UPDATE',Select.ForUpdate<>nil,true);
+  AssertEquals('FOR UPDATE list count',Select.ForUpdate.Count,2);
+  AssertIdentifierName('FOR UPDATE[0]','B',Select.ForUpdate[0]);
+  AssertIdentifierName('FOR UPDATE[1]','C',Select.ForUpdate[1]);
+end;
+
+procedure TTestSelectParser.TestWithLock;
+begin
+  TestSelect('SELECT * FROM DOCUMENT WITH LOCK');
+  AssertEquals('WITH LOCK',Select.WithLock,true);
+end;
+
 procedure TTestSelectParser.TestSelectTwoFieldsTwoInnerTablesJoin;
 Var
   J : TSQLJoinTableReference;