sql parser: support LIMIT for FireBird/MSSQL/Postgres/MySQL

git-svn-id: trunk@46426 -

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

@@ -126,6 +126,7 @@ Type
     procedure ParseFromClause(AParent: TSQLSelectStatement; AList: TSQLElementList);
     procedure ParseGroupBy(AParent: TSQLSelectStatement; AList: TSQLElementList);
     procedure ParseOrderBy(AParent: TSQLSelectStatement; AList: TSQLElementList);
+    procedure ParseLimit(AParent: TSQLSelectStatement; ALimit: TSQLSelectLimit);
     procedure ParseSelectFieldList(AParent: TSQLSelectStatement; AList: TSQLElementList; Singleton : Boolean);
     function ParseForUpdate(AParent: TSQLSelectStatement): TSQLElementList;
     function ParseSelectPlan(AParent: TSQLElement): TSQLSelectPlan;
@@ -436,6 +437,29 @@ begin
     GetNextToken;
     If B then
       begin
+      if (CurrentToken=tsqlTop) then
+        begin
+        GetNextToken;
+        Expect(tsqlIntegerNumber);
+        AParent.Limit.Style := lsMSSQL;
+        AParent.Limit.Top := StrToInt(CurrentTokenString);
+        GetNextToken;
+        end;
+      if (CurrentToken=tsqlFIRST) then
+        begin
+        GetNextToken;
+        Expect(tsqlIntegerNumber);
+        AParent.Limit.Style := lsFireBird;
+        AParent.Limit.First := StrToInt(CurrentTokenString);
+        GetNextToken;
+        if (CurrentToken=tsqlSKIP) then
+          begin
+          GetNextToken;
+          Expect(tsqlIntegerNumber);
+          AParent.Limit.Skip := StrToInt(CurrentTokenString);
+          GetNextToken;
+          end;
+        end;
       if (CurrentToken=tsqlDistinct) then
         begin
         AParent.Distinct:=True;
@@ -721,6 +745,8 @@ begin
       begin
       if (CurrentToken=tsqlOrder) then
         ParseOrderBy(Result,Result.OrderBy);
+      if CurrentToken in [tsqlLimit,tsqlOFFSET] then
+        ParseLimit(Result,Result.Limit);
       if (CurrentToken=tsqlFOR) then
         Result.ForUpdate:=ParseForUpdate(Result);
       end;
@@ -1319,6 +1345,46 @@ begin
   Until (CurrentToken<>tsqlComma);
 end;
 
+procedure TSQLParser.ParseLimit(AParent: TSQLSelectStatement; ALimit: TSQLSelectLimit);
+
+  procedure DoOffset;
+  begin
+    if CurrentToken=tsqlOFFSET then
+      begin
+      GetNextToken;
+      Expect(tsqlIntegerNumber);
+      ALimit.Offset := StrToInt(CurrentTokenString);
+      GetNextToken;
+      end;
+  end;
+begin
+  ALimit.Style:=lsPostgres;
+  if CurrentToken=tsqlLIMIT then
+    begin
+    GetNextToken;
+    if CurrentToken=tsqlALL then
+      ALimit.RowCount := -1
+    else
+      begin
+      Expect(tsqlIntegerNumber);
+      ALimit.RowCount := StrToInt(CurrentTokenString);
+      end;
+    GetNextToken;
+    if CurrentToken=tsqlCOMMA then
+      begin
+      GetNextToken;
+      Expect(tsqlIntegerNumber);
+      ALimit.Offset := ALimit.RowCount;
+      ALimit.RowCount := StrToInt(CurrentTokenString);
+      GetNextToken;
+      end
+    else
+      DoOffset;
+    end
+  else
+    DoOffset;
+end;
+
 function TSQLParser.ParseForStatement(AParent: TSQLElement): TSQLForStatement;
 
 begin

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

@@ -54,20 +54,20 @@ type
    tsqlCOLLATE, tsqlCONTAINING, tsqlCOUNT, tsqlCREATE, tsqlCOLUMN, tsqlCONSTRAINT, tsqlChar,tsqlCHARACTER, tsqlCHECK, tsqlComputed,tsqlCASCADE, tsqlCast, tsqlCommit,tsqlConnect,tsqlCache,tsqlConditional,tsqlCString,
    tsqlDESC, tsqlDESCENDING, tsqlDISTINCT, tsqlDEFAULT, tsqlDELETE, tsqlDO, tsqlDouble, tsqlDECLARE, tsqlDROP, tsqlDomain, tsqlDecimal, tsqlDate,tsqlDatabase,
    tsqlESCAPE, tsqlEXISTS, tsqlELSE, tsqlException,   tsqlExternal, tsqlExecute, tsqlEnd,tsqlExit,tsqlEntrypoint,tsqlExtract,
-   tsqlFROM, tsqlFULL, tsqlFOREIGN, tsqlFOR, tsqlFUNCTION, tsqlFLOAT, tsqlFile,tsqlFreeIt,
+   tsqlFIRST, tsqlFROM, tsqlFULL, tsqlFOREIGN, tsqlFOR, tsqlFUNCTION, tsqlFLOAT, tsqlFile,tsqlFreeIt,
    tsqlGenerator, tsqlGROUP, tsqlGenID,tsqlGDSCODE,tsqlGrant,
    tsqlHAVING,
    tsqlIF, tsqlIN, tsqlINNER, tsqlINSERT, tsqlINT, tsqlINTEGER, tsqlINTO, tsqlIS, tsqlINDEX,  tsqlInactive,
    tsqlJOIN,
    tsqlKEY,
-   tsqlLEFT, tsqlLIKE, tsqlLength,
+   tsqlLEFT, tsqlLIKE, tsqlLIMIT, tsqlLength,
    tsqlMAX, tsqlMIN, tsqlMERGE, tsqlManual, tsqlModuleName,
    tsqlNOT, tsqlNULL, tsqlNUMERIC , tsqlNChar, tsqlNATIONAL,tsqlNO, tsqlNatural,
-   tsqlOFF {not an FB reserved word; used in isql scripts}, tsqlON, tsqlOR, tsqlORDER, tsqlOUTER, tsqlOption,
+   tsqlOFF {not an FB reserved word; used in isql scripts}, tsqlOFFSET, tsqlON, tsqlOR, tsqlORDER, tsqlOUTER, tsqlOption,
    tsqlPrecision, tsqlPRIMARY,  tsqlProcedure, tsqlPosition, tsqlPlan, tsqlPassword, tsqlPage,tsqlPages,tsqlPageSize,tsqlPostEvent,tsqlPrivileges,tsqlPublic,
    tsqlRIGHT, tsqlROLE, tsqlReferences, tsqlRollBack, tsqlRelease,  tsqlretain,  tsqlReturningValues,tsqlReturns, tsqlrevoke,
    tsqlSELECT, tsqlSET, tsqlSINGULAR, tsqlSOME, tsqlSTARTING, tsqlSUM, tsqlSKIP,tsqlSUBTYPE,tsqlSize,tsqlSegment, tsqlSORT, tsqlSnapShot,tsqlSchema,tsqlShadow,tsqlSuspend,tsqlSQLCode,tsqlSmallint,
-   tSQLTABLE, tsqlText, tsqlTrigger, tsqlTime, tsqlTimeStamp, tsqlType, tsqlTo, tsqlTransaction, tsqlThen,
+   tSQLTABLE, tsqlText, tsqlTrigger, tsqlTime, tsqlTimeStamp, tsqlType, tsqlTo, tsqlTop, tsqlTransaction, tsqlThen,
    tsqlUNION, tsqlUPDATE, tsqlUPPER,  tsqlUNIQUE, tsqlUSER,
    tsqlValue, tsqlVALUES, tsqlVARIABLE,  tsqlVIEW, tsqlVARCHAR,TSQLVARYING,
    tsqlWHERE, tsqlWITH, tsqlWHILE, tsqlWork, tsqlWhen,tsqlSequence,tsqlRestart,tsqlrecreate,tsqlterm
@@ -100,20 +100,20 @@ const
        'COLLATE', 'CONTAINING', 'COUNT', 'CREATE', 'COLUMN', 'CONSTRAINT', 'CHAR','CHARACTER','CHECK', 'COMPUTED','CASCADE','CAST', 'COMMIT', 'CONNECT', 'CACHE','CONDITIONAL', 'CSTRING',
        'DESC', 'DESCENDING', 'DISTINCT',  'DEFAULT', 'DELETE', 'DO', 'DOUBLE', 'DECLARE', 'DROP', 'DOMAIN', 'DECIMAL', 'DATE','DATABASE',
        'ESCAPE', 'EXISTS', 'ELSE', 'EXCEPTION', 'EXTERNAL','EXECUTE', 'END','EXIT','ENTRY_POINT','EXTRACT',
-       'FROM', 'FULL','FOREIGN', 'FOR', 'FUNCTION', 'FLOAT','FILE', 'FREE_IT',
+       'FIRST', 'FROM', 'FULL','FOREIGN', 'FOR', 'FUNCTION', 'FLOAT','FILE', 'FREE_IT',
        'GENERATOR', 'GROUP', 'GEN_ID','GDSCODE','GRANT',
        'HAVING',
        'IF', 'IN', 'INNER', 'INSERT', 'INT', 'INTEGER', 'INTO', 'IS', 'INDEX', 'INACTIVE',
        'JOIN',
        'KEY',
-       'LEFT', 'LIKE', 'LENGTH',
+       'LEFT', 'LIKE', 'LIMIT', 'LENGTH',
        'MAX', 'MIN', 'MERGE', 'MANUAL', 'MODULE_NAME',
        'NOT', 'NULL', 'NUMERIC','NCHAR','NATIONAL', 'NO', 'NATURAL',
-       'OFF', 'ON', 'OR', 'ORDER', 'OUTER', 'OPTION',
+       'OFF', 'OFFSET', 'ON', 'OR', 'ORDER', 'OUTER', 'OPTION',
        'PRECISION', 'PRIMARY', 'PROCEDURE','POSITION','PLAN', 'PASSWORD','PAGE','PAGES','PAGE_SIZE','POST_EVENT','PRIVILEGES','PUBLIC',
        'RIGHT', 'ROLE', 'REFERENCES', 'ROLLBACK','RELEASE', 'RETAIN', 'RETURNING_VALUES', 'RETURNS','REVOKE',
        'SELECT', 'SET', 'SINGULAR', 'SOME', 'STARTING', 'SUM', 'SKIP','SUB_TYPE', 'SIZE', 'SEGMENT', 'SORT', 'SNAPSHOT','SCHEMA','SHADOW','SUSPEND','SQLCODE','SMALLINT',
-       'TABLE', 'TEXT', 'TRIGGER', 'TIME', 'TIMESTAMP', 'TYPE', 'TO', 'TRANSACTION', 'THEN',
+       'TABLE', 'TEXT', 'TRIGGER', 'TIME', 'TIMESTAMP', 'TYPE', 'TO', 'TOP', 'TRANSACTION', 'THEN',
        'UNION', 'UPDATE', 'UPPER', 'UNIQUE', 'USER',
        'VALUE','VALUES','VARIABLE', 'VIEW','VARCHAR','VARYING',
        'WHERE', 'WITH', 'WHILE','WORK','WHEN','SEQUENCE','RESTART','RECREATE','TERM'

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

@@ -726,11 +726,32 @@ Type
     Property OrderBy : TSQLOrderDirection Read FOrderBy write FOrderBy;
   end;
 
+  { TSQLSelectLimit }
+
+  TSQLSelectLimitStyle = (lsNone, lsFireBird, lsMSSQL, lsPostgres{lsMySQL});
+
+  TSQLSelectLimit = Class
+  private
+    FRowCount: Integer;
+    FSkip: Integer;
+    FStyle: TSQLSelectLimitStyle;
+  public
+    constructor Create;
+  public
+    property Style: TSQLSelectLimitStyle read FStyle write FStyle;
+    property First: Integer read FRowCount write FRowCount; // lsFireBird
+    property Skip: Integer read FSkip write FSkip; // lsFireBird
+    property Top: Integer read FRowCount write FRowCount; // lsMSSQL
+    property RowCount: Integer read FRowCount write FRowCount; // lsPostgres
+    property Offset: Integer read FSkip write FSkip; // lsPostgres
+  end;
+
   { TSQLSelectStatement }
 
   TSQLSelectStatement = Class(TSQLDMLStatement)
   private
     FAll: Boolean;
+    FLimit: TSQLSelectLimit;
     FDistinct: Boolean;
     FEndAt: TSQLExpression;
     FFields: TSQLElementList;
@@ -760,6 +781,7 @@ Type
     Property ForUpdate : TSQLElementList Read FForUpdate Write FForUpdate;
     Property Union : TSQLSelectStatement Read FUnion Write FUnion;
     Property Plan : TSQLSelectPlan Read FPlan Write FPlan;
+    Property Limit: TSQLSelectLimit Read FLimit;
     Property Distinct : Boolean Read FDistinct Write FDistinct;
     Property All : Boolean Read FAll Write FAll;
     Property UnionAll : Boolean Read FUnionAll Write FUnionAll;
@@ -1915,6 +1937,15 @@ begin
     Sep:=', ';
 end;
 
+{ TSQLSelectLimit }
+
+constructor TSQLSelectLimit.Create;
+begin
+  inherited Create;
+  FSkip:=-1;
+  FRowCount:=-1;
+end;
+
 { TSQLSetTermStatement }
 
 function TSQLSetTermStatement.GetAsSQL(Options: TSQLFormatOptions; AIndent: Integer): TSQLStringType;
@@ -1994,6 +2025,7 @@ begin
   FTables:=TSQLElementList.Create(True);
   FGroupBy:=TSQLElementList.Create(True);
   FOrderBy:=TSQLElementList.Create(True);
+  FLimit:=TSQLSelectLimit.Create;
 end;
 
 destructor TSQLSelectStatement.Destroy;
@@ -2011,6 +2043,7 @@ begin
   FreeAndNil(FForUpdate);
   FreeAndNil(FTN);
   FreeAndNil(FInto);
+  FreeAndNil(FLimit);
   inherited Destroy;
 end;
 
@@ -2078,6 +2111,15 @@ Var
 
 begin
   Result:=SQLKeyWord('SELECT',Options);
+  If Limit.Style=lsMSSQL then
+    Result:=Result+' '+SQLKeyword('TOP',Options)+' '+IntToStr(Limit.Top)
+  else
+  If Limit.Style=lsFireBird then
+    begin
+    Result:=Result+' '+SQLKeyword('FIRST',Options)+' '+IntToStr(Limit.First);
+    if Limit.Skip>=0 then
+      Result:=Result+' '+SQLKeyword('SKIP',Options)+' '+IntToStr(Limit.Skip);
+    end;
   If Distinct then
     Result:=Result+' '+SQLKeyword('DISTINCT',Options);
   NewLinePending:=(sfoOneFieldPerLine in Options);
@@ -2093,6 +2135,13 @@ begin
     NewLinePending:=NewLinePending or (sfoPlanOnSeparateLine in Options);
   AddExpression('PLAN',Plan,(sfoPlanOnSeparateLine in Options),(sfoIndentPlan in Options));
   AddList('ORDER BY',OrderBy,(sfoOneOrderByFieldPerLine in Options),(sfoIndentOrderByFields in Options));
+  If Limit.Style=lsPostgres then
+    begin
+    if Limit.RowCount>=0 then
+      Result:=Result+' '+SQLKeyword('LIMIT',Options)+' '+IntToStr(Limit.RowCount);
+    if Limit.Offset>=0 then
+      Result:=Result+' '+SQLKeyword('OFFSET',Options)+' '+IntToStr(Limit.Offset);
+    end;
 end;
 
 { TSQLInsertStatement }

packages/fcl-db/tests/tcgensql.pas

@@ -97,6 +97,7 @@ type
     procedure TestPlanExpression;
     procedure TestOrderBy;
     Procedure TestSelect;
+    Procedure TestLimit;
     procedure TestInsert;
     procedure TestUpdatePair;
     procedure TestUpdate;
@@ -995,6 +996,33 @@ begin
   AssertSQL(J,'(E JOIN F ON (G = H)) FULL OUTER JOIN A ON (C = D)',[sfoBracketLeftJoin]);
 end;
 
+procedure TTestGenerateSQL.TestLimit;
+
+Var
+  S : TSQLSelectStatement;
+
+begin
+  S:=CreateSelect(CreateIdentifierExpression('A'),'B');
+
+  S.Limit.Style:=lsFireBird;
+  S.Limit.First := 10;
+  AssertSQL(S,'SELECT FIRST 10 A FROM B');
+  S.Limit.Style:=lsMSSQL;
+  AssertSQL(S,'SELECT TOP 10 A FROM B');
+  S.Limit.Style:=lsPostgres;
+  AssertSQL(S,'SELECT A FROM B LIMIT 10');
+
+  S.Limit.Skip := 20;
+  S.Limit.Style:=lsFireBird;
+  AssertSQL(S,'SELECT FIRST 10 SKIP 20 A FROM B');
+  S.Limit.Style:=lsPostgres;
+  AssertSQL(S,'SELECT A FROM B LIMIT 10 OFFSET 20');
+
+  S.Limit.RowCount := -1;
+  S.Limit.Style:=lsPostgres;
+  AssertSQL(S,'SELECT A FROM B OFFSET 20');
+end;
+
 procedure TTestGenerateSQL.TestPlanNatural;
 
 Var

packages/fcl-db/tests/tcparser.pas

@@ -413,6 +413,15 @@ type
     procedure TestSelectTwoFieldsThreeBracketTablesJoin;
     procedure TestSelectTableWithSchema;
     procedure TestSelectFieldWithSchema;
+    procedure TestSelectFirst;
+    procedure TestSelectFirstSkip;
+    procedure TestSelectTop;
+    procedure TestSelectLimit;
+    procedure TestSelectLimitAll;
+    procedure TestSelectLimitAllOffset;
+    procedure TestSelectLimitOffset1;
+    procedure TestSelectLimitOffset2;
+    procedure TestSelectOffset;
     procedure TestAggregateCount;
     procedure TestAggregateCountAsterisk;
     procedure TestAggregateCountAll;
@@ -3758,6 +3767,73 @@ begin
   AssertEquals('Schema name = S','S',(Select.Tables[0] as TSQLSimpleTableReference).ObjectNamePath[0].Name);
 end;
 
+procedure TTestSelectParser.TestSelectFirst;
+begin
+  // FireBird
+  TestSelect('SELECT FIRST 100 A FROM B');
+  AssertEquals('Limit style',Ord(lsFireBird),Ord(Select.Limit.Style));
+  AssertEquals('Limit FIRST 100',100,Select.Limit.First);
+end;
+
+procedure TTestSelectParser.TestSelectFirstSkip;
+begin
+  // FireBird
+  TestSelect('SELECT FIRST 100 SKIP 200 A FROM B');
+  AssertEquals('Limit style',Ord(lsFireBird),Ord(Select.Limit.Style));
+  AssertEquals('Limit FIRST 100',100,Select.Limit.First);
+  AssertEquals('Limit SKIP 200',200,Select.Limit.Skip);
+end;
+
+procedure TTestSelectParser.TestSelectLimit;
+begin
+  // MySQL&Postgres
+  TestSelect('SELECT A FROM B LIMIT 100');
+  AssertEquals('Limit style',Ord(lsPostgres),Ord(Select.Limit.Style));
+  AssertEquals('Limit RowCount 100',100,Select.Limit.RowCount);
+end;
+
+procedure TTestSelectParser.TestSelectLimitAll;
+begin
+  // Postgres
+  TestSelect('SELECT A FROM B LIMIT ALL');
+  AssertEquals('Limit style',Ord(lsPostgres),Ord(Select.Limit.Style));
+  AssertEquals('Limit RowCount -1',-1,Select.Limit.RowCount);
+end;
+
+procedure TTestSelectParser.TestSelectLimitAllOffset;
+begin
+  // Postgres
+  TestSelect('SELECT A FROM B LIMIT ALL OFFSET 200');
+  AssertEquals('Limit style',Ord(lsPostgres),Ord(Select.Limit.Style));
+  AssertEquals('Limit Offset 200',200,Select.Limit.Offset);
+end;
+
+procedure TTestSelectParser.TestSelectLimitOffset1;
+begin
+  // MySQL
+  TestSelect('SELECT A FROM B LIMIT 200, 100');
+  AssertEquals('Limit style',Ord(lsPostgres),Ord(Select.Limit.Style));
+  AssertEquals('Limit RowCount 100',100,Select.Limit.RowCount);
+  AssertEquals('Limit Offset 200',200,Select.Limit.Offset);
+end;
+
+procedure TTestSelectParser.TestSelectLimitOffset2;
+begin
+  // MySQL&Postgres
+  TestSelect('SELECT A FROM B LIMIT 100 OFFSET 200');
+  AssertEquals('Limit style',Ord(lsPostgres),Ord(Select.Limit.Style));
+  AssertEquals('Limit RowCount 100',100,Select.Limit.RowCount);
+  AssertEquals('Limit Offset 200',200,Select.Limit.Offset);
+end;
+
+procedure TTestSelectParser.TestSelectOffset;
+begin
+  // Postgres
+  TestSelect('SELECT A FROM B OFFSET 200');
+  AssertEquals('Limit style',Ord(lsPostgres),Ord(Select.Limit.Style));
+  AssertEquals('Limit Offset 200',200,Select.Limit.Offset);
+end;
+
 procedure TTestSelectParser.TestSelectOneFieldOneTable;
 begin
   TestSelect('SELECT B FROM A');
@@ -3850,6 +3926,14 @@ begin
   AssertEquals('Schema name = S','S',(Select.Tables[0] as TSQLSimpleTableReference).ObjectNamePath[0].Name);
 end;
 
+procedure TTestSelectParser.TestSelectTop;
+begin
+  // MSSQL
+  TestSelect('SELECT TOP 100 A FROM B');
+  AssertEquals('Limit style',Ord(lsMSSQL),Ord(Select.Limit.Style));
+  AssertEquals('Limit TOP 100',100,Select.Limit.Top);
+end;
+
 procedure TTestSelectParser.TestSelectOneDistinctFieldOneTable;
 begin
   TestSelect('SELECT DISTINCT B FROM A');