浏览代码

* Fix bug ID #32625: added several firebird constructs

git-svn-id: trunk@43139 -
michael 5 年之前
父节点
当前提交
01b946706b

+ 1 - 0
.gitattributes

@@ -3173,6 +3173,7 @@ packages/fcl-db/examples/loadlibdemo.pp svneol=native#text/plain
 packages/fcl-db/examples/logsqldemo.lpi svneol=native#text/plain
 packages/fcl-db/examples/logsqldemo.pas svneol=native#text/plain
 packages/fcl-db/examples/myext.pp svneol=native#text/plain
+packages/fcl-db/examples/parsesql.pas svneol=native#text/plain
 packages/fcl-db/examples/pqeventstest.pp svneol=native#text/plain
 packages/fcl-db/examples/showcsv.pp svneol=native#text/plain
 packages/fcl-db/examples/sqlite3extdemo.pp svneol=native#text/plain

+ 64 - 0
packages/fcl-db/examples/parsesql.pas

@@ -0,0 +1,64 @@
+{
+    This file is part of the Free Component Library
+    Copyright (c) 2019 by the Free Pascal development team
+
+    Demo for SQL source syntax parser
+
+    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.
+
+ **********************************************************************}
+
+program parsesql;
+
+uses sysutils, classes, fpsqlparser, fpsqlscanner,fpsqltree;
+
+Procedure parseScript(const aFilename:String; AScript  :TStringList);
+
+var
+  i: integer;
+  Parser: TSQLParser;
+  ResultList: TSQLElementList;
+  ScriptStream:TFileStream;
+begin
+  ScriptStream:=TFileStream.Create(aFilename, fmopenreadwrite or fmshareexclusive);
+  try
+    ScriptStream.Position:=0;
+    Parser := TSQLParser.Create(ScriptStream);
+    try
+      ResultList := Parser.ParseScript([poAllowSetTerm]);
+      for i:=0 to ResultList.Count-1 do
+        AScript.Add(ResultList[i].GetAsSQL([sfoDoubleQuoteIdentifier]));
+    finally
+      Parser.Free;
+    end;
+  finally
+    ScriptStream.Free;
+    ResultList.Free;
+  end;
+end;
+
+Var
+  L : TStringList;
+  S : String;
+
+begin
+  if ParamCount<>1 then
+    begin
+    Writeln('Parse & Dump SQL');
+    Writeln('Usage : parsesql <filename>');
+    Halt(1);
+    end;
+  L:=TStringList.Create;
+  try
+    ParseScript(ParamStr(1),L);
+    for S in L do Writeln(S);
+  Finally
+    L.Free;
+  end;
+end.
+

+ 167 - 37
packages/fcl-db/src/sql/fpsqlparser.pas

@@ -35,10 +35,14 @@ Type
   TSelectFlag = (sfSingleTon,sfUnion,sfInto);
   TSelectFlags = Set of TSelectFlag;
 
+  TParserOption = (poPartial,poAllowSetTerm);
+  TParserOptions = set of TParserOption;
+
   { TSQLParser }
 
   TSQLParser = Class(TObject)
   Private
+    FOptions : TParserOptions;
     FInput : TStream;
     FScanner : TSQLScanner;
     FCurrent : TSQLToken;
@@ -100,6 +104,7 @@ Type
     function ParseAlterTableStatement(AParent: TSQLElement): TSQLAlterTableStatement;
     function ParseCreateViewStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
     function ParseCreateTriggerStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
+    function ParseSetTermStatement(AParent: TSQLElement): TSQLSetTermStatement;
     function ParseSetGeneratorStatement(AParent: TSQLElement) : TSQLSetGeneratorStatement;
     function ParseCreateDatabaseStatement(AParent: TSQLElement; IsAlter: Boolean ): TSQLCreateDatabaseStatement;
     function ParseCreateShadowStatement(AParent: TSQLElement; IsAlter: Boolean ): TSQLCreateShadowStatement;
@@ -158,9 +163,11 @@ Type
     Function ParseGrantStatement(AParent: TSQLElement): TSQLGrantStatement;
     Function ParseRevokeStatement(AParent: TSQLElement): TSQLGrantStatement;
     // Parse single element
-    Function Parse : TSQLElement;
+    Function Parse : TSQLElement; overload;
+    Function Parse(aOptions : TParserOptions) : TSQLElement; overload;
     // Parse script containing 1 or more elements
-    Function ParseScript(AllowPartial : Boolean = False) : TSQLElementList;
+    Function ParseScript(AllowPartial : Boolean) : TSQLElementList; deprecated 'use options';
+    Function ParseScript(aOptions : TParserOptions = []) : TSQLElementList;
     // Auxiliary stuff
     Function CurrentToken : TSQLToken;
     Function CurrentTokenString : String;
@@ -173,6 +180,8 @@ Type
     function CurSource: String;
     Function CurLine : Integer;
     Function CurPos : Integer;
+    Property Options : TParserOptions Read FOptions;
+    Property Scanner : TSQLScanner Read FScanner;
   end;
 
   { ESQLParser }
@@ -196,19 +205,19 @@ uses typinfo;
 
 Resourcestring
   SerrUnmatchedBrace  = 'Expected ).';
-  SErrCommaOrBraceExpected = 'Expected , or ).';
+  // SErrCommaOrBraceExpected = 'Expected , or ).';
   SErrUnexpectedToken = 'Unexpected token: %s';
   SErrUnexpectedTokenOf = 'Unexpected token: %s, expected one of %s';
   SErrTokenMismatch   = 'Unexpected token: ''%s'', expected: ''%s''';
   SErrExpectedDBObject = 'Expected database object type. Got: ''%s''';
   SErrDomainNotAllowed = 'Domain name not allowed in type definition.';
-  SErrExpectedChar = 'Expected CHAR or CHARACTER, got "%s"';
+  //SErrExpectedChar = 'Expected CHAR or CHARACTER, got "%s"';
   SErrVaryingNotAllowed = 'VARYING not allowed at this point.';
   SErrUnknownBooleanOp = 'Unknown boolean operation';
   SErrUnknownComparison = 'unknown Comparison operation';
   SErrIntegerExpected = 'Integer expression expected';
   SErrInvalidUseOfCollate = 'Invalid use of COLLATE';
-  SErrCannotAlterGenerator = 'Alter generator statement unknown';
+  //SErrCannotAlterGenerator = 'Alter generator statement unknown';
   SErrInvalidLiteral = 'Invalid literal: "%s"';
   SErrNoAggregateAllowed = 'Aggregate function not allowed.';
   SErrAsteriskOnlyInCount = '* allowed only in COUNT aggregate';
@@ -218,6 +227,8 @@ Resourcestring
   SErrUnionFieldCountMatch =  'Field count mismatch in select union : %d <> %d';
   SErrInvalidExtract = 'Invalid element for extract: %s';
   SErrOuterWithout = 'OUTER without preceding LEFT, RIGHT or FULL';
+  // SErrRestartWithAlter = 'RESTART only with ALTER SEQUENCE';
+  SErrCommaOrSquareArray = 'Expected , or ] in array dimension';
 
 Function StringToSQLExtractElement(Const S : TSQLStringType; Out Res : TSQLExtractElement) : Boolean;
 
@@ -365,6 +376,8 @@ begin
           tsqlFull  : J.JoinType:=jtFullOuter;
           tsqlLeft  : J.JoinType:=jtLeft;
           tsqlRight : J.JoinType:=jtRight;
+       else
+         expect([tsqlInner,tsqlFull,tsqlJoin,tsqlOuter,tsqlLeft,tsqlRight]);
        end;
        if CurrentToken<>tsqlJoin then
          GetNextToken;
@@ -627,6 +640,8 @@ begin
         tsqlBraceOpen : E.Jointype:=pjtJoin;
         tsqlSort  : E.JoinType:=pjtSort;
         tsqlMerge : E.JoinType:=pjtMerge;
+      else
+        expect([tsqlJoin,tsqlmerge,tsqlSort,tsqlBraceOpen]);
       end;
       If (CurrentToken<>tsqlBraceOpen) then
         GetNextToken;
@@ -1140,7 +1155,7 @@ begin
         GetNextToken;
         Include(O,ioAscending);
         end
-      else If (CurrentToken=tsqlDescending) then
+      else If (CurrentToken=tsqlDescending) or  (CurrentToken=tsqlDesc) then
         begin
         GetNextToken;
         Include(O,ioDescending);
@@ -1255,8 +1270,6 @@ end;
 
 function TSQLParser.ParseIfStatement(AParent: TSQLElement): TSQLIFStatement;
 
-Var
-  Pt : TSQLToken;
 
 begin
   // On Entry, we're on the IF token
@@ -1269,10 +1282,7 @@ begin
     Consume(tsqlThen);
     Result.TrueBranch:=ParseProcedureStatement(Result);
     If (CurrentToken=tsqlSemicolon) and (PeekNextToken=tsqlElse) then
-      begin
-      PT:=CurrentToken;
-      GetNextToken;
-      end
+      GetNextToken
     else if (CurrentToken=tsqlElse) then
       if not (PreviousToken=tsqlEnd) then
         UnexpectedToken;
@@ -1558,19 +1568,39 @@ end;
 
 function TSQLParser.ParseCreateGeneratorStatement(AParent: TSQLElement; IsAlter: Boolean
   ): TSQLCreateOrAlterStatement;
+
+Var
+  isSequence : Boolean;
+  Gen : TSQLCreateOrAlterGenerator;
+  Alt : TSQLAlterGeneratorStatement absolute gen;
+
 begin
+  isSequence:=CurrentToken=tsqlSequence;
   GetNextToken;
   Expect(tsqlIdentifier);
-  If IsAlter then
-    Error(SErrCannotAlterGenerator);
-  Result:=TSQLCreateOrAlterStatement(CreateElement(TSQLCreateGeneratorStatement,AParent));
+  if isAlter then
+    Gen:=TSQLCreateOrAlterGenerator(CreateElement(TSQLAlterGeneratorStatement,AParent))
+  else
+    Gen:=TSQLCreateOrAlterGenerator(CreateElement(TSQLCreateGeneratorStatement,AParent));
   try
+    Result:=Gen;
     Result.ObjectName:=CreateIdentifier(Result,CurrentTokenString);
+    Gen.IsSequence:=isSequence;
+    GetNextToken;
+    if isAlter then
+      begin
+      Expect(tsqlrestart);
+      Alt.HasRestart:=True;
+      GetNexttoken;
+      Consume(tsqlWith);
+      Expect(tsqlIntegerNumber);
+      Alt.Restart:=StrToInt(CurrentTokenString);
+      GetNexttoken;
+      end
   except
     FreeAndNil(Result);
     Raise;
   end;
-  GetNextToken; // Comma;
 end;
 
 function TSQLParser.ParseCreateRoleStatement(AParent: TSQLElement;
@@ -1602,6 +1632,8 @@ begin
      GetNextToken;
      expect([tsqlCharacter,tsqlChar]);
      end;
+  else
+    Expect([tsqlNCHAR,tsqlVarChar,tsqlCharacter,tsqlChar, tsqlCString, tsqlNational]);
   end;
   GetNextToken; // VARYING, Start of size, CHARACTER SET or end
   If (CurrentToken=tsqlVarying) then  // CHAR VARYING or CHARACTER VARYING;
@@ -1854,13 +1886,15 @@ end;
 function TSQLParser.ParseTypeDefinition(AParent: TSQLElement;
   Flags: TParseTypeFlags): TSQLTypeDefinition;
 
+
+
 Var
   TN : String;
+  adCount : Integer;
+  ADS : TArrayDims;
   AD : Integer;
   DT : TSQLDataType;
-  AA : Boolean; // Allow Array
   GN : Boolean; // Do GetNextToken ?
-  NN : Boolean; // Not Null ?
   sc,prec : Integer;
   bt : integer;
   D : TSQLTypeDefinition;
@@ -1870,12 +1904,10 @@ Var
 
 begin
   // We are positioned on the token prior to the type definition.
-  AA:=True;
   GN:=True;
   prec:=0;
   sc:=0;
   bt:=0;
-  NN:=True;
   Coll:=Nil;
   Case GetNextToken of
     tsqlIdentifier :
@@ -1956,12 +1988,30 @@ begin
   If GN then
     GetNextToken;
   // We are now on array definition or rest of type.
+  ADCount:=0;
+  ADS:=Default(TArrayDims);
   If (CurrentToken=tsqlSquareBraceOpen) then
     begin
-    GetNextToken;
-    Expect(tsqlIntegerNumber);
-    AD:=Strtoint(CurrentTokenString);
-    GetNextToken;
+    Repeat
+      GetNextToken;
+      Expect(tsqlIntegerNumber);
+      AD:=StrToInt(CurrentTokenString);
+      Inc(ADCount);
+      SetLength(ADS,ADCount);
+      ADS[ADCount-1][1]:=1;
+      ADS[ADCount-1][2]:=AD;
+      GetNextToken;
+      if CurrentToken=tsqlCOLON then
+        begin
+        GetNextToken;
+        Expect(tsqlIntegerNumber);
+        AD:=Strtoint(CurrentTokenString);
+        ADS[ADCount-1][1]:=AD;
+        GetNextToken;
+        end;
+      if Not (CurrentToken in [tsqlSquareBraceClose,tsqlComma]) then
+        Error(SErrCommaOrSquareArray);
+    until (CurrentToken=tsqlSquareBraceClose);
     Expect(tsqlSquareBraceClose);
     GetNextToken;
     end
@@ -1988,7 +2038,7 @@ begin
     D.Len:=PRec;
     D.Scale:=Sc;
     D.BlobType:=bt;
-    D.ArrayDim:=AD;
+    D.ArrayDims:=ADS;
     D.Charset:=CS;
     D.Collation:=Coll;
     D.Constraint:=C;
@@ -2105,7 +2155,6 @@ function TSQLParser.ParseExprLevel1(AParent: TSQLElement; EO: TExpressionOptions
 var
   tt: TSQLToken;
   B : TSQLBinaryExpression;
-  Right: TSQLExpression;
   L : TSQLLiteralExpression;
 
 begin
@@ -2348,6 +2397,8 @@ begin
         tsqlPlus  : B.Operation:=boAdd;
         tsqlMinus : B.Operation:=boSubtract;
         tsqlConcatenate : B.Operation:=boConcat;
+      else
+        expect([tsqlPlus,tsqlMinus,tsqlConcatenate]);
       end;
       end;
   Except
@@ -2380,6 +2431,8 @@ begin
       Case tt of
         tsqlMul : B.Operation:=boMultiply;
         tsqlDiv : B.Operation:=boDivide;
+      else
+        // Do nothing
       end;
       end;
   Except
@@ -2459,14 +2512,10 @@ end;
 function TSQLParser.ParseIdentifierList(AParent: TSQLElement;
   AList: TSQLelementList): integer;
 
-Var
-  Done : Boolean;
-
 begin
   // on entry, we're on first identifier
   Expect(tsqlIdentifier);
   Result:=0;
-  Done:=False;
   repeat
     if CurrentToken=tsqlComma then
       GetNextToken;
@@ -2545,6 +2594,8 @@ begin
       tsqlAvg : Result.Aggregate:=afAvg;
       tsqlMax : Result.Aggregate:=afMax;
       tsqlMin : Result.Aggregate:=afMin;
+    else
+      Expect([tsqlMin,tsqlMax,tsqlAvg,tsqlSum,tsqlCount]);
     end;
     GetNextToken;
     Consume(tsqlBraceOpen);
@@ -2635,6 +2686,8 @@ begin
           tsqlAny      : C:=TSQLAnyExpression;
           tsqlSome     : C:=TSQLSomeExpression;
           tsqlSingular : C:=TSQLSingularExpression;
+        else
+          expect([tsqlExists, tsqlAll,tsqlAny,tsqlSome,tsqlSingular]);
         end;
         GetNextToken;
         Consume(tsqlBraceOpen);
@@ -2927,11 +2980,12 @@ begin
       T.Moment:=tmAfter;
     Repeat
       GetNextToken;
-      Expect([tsqlDelete,tsqlInsert,tsqlUpdate]);
       Case CurrentToken of
         tsqlDelete : T.Operations:=T.Operations+[toDelete];
         tsqlUpdate : T.Operations:=T.Operations+[toUpdate];
         tsqlInsert : T.Operations:=T.Operations+[toInsert];
+      else
+        Expect([tsqlDelete,tsqlInsert,tsqlUpdate]);
       end;
       GetNextToken;
     Until (CurrentToken<>tsqlOr);
@@ -2973,6 +3027,36 @@ begin
   end;
 end;
 
+function TSQLParser.ParseSetTermStatement(AParent: TSQLElement ): TSQLSetTermStatement;
+begin
+  // On entry, we're on the 'TERM' token
+  Consume(tsqlTerm) ;
+  try
+    Result:=TSQLSetTermStatement(CreateElement(TSQLSetTermStatement,AParent));
+    case CurrentToken of
+      // Only semicolon or something unknown are allowed.
+      tsqlSemiColon : Result.NewValue:=TokenInfos[CurrentToken];
+      tsqlunknown : Result.NewValue:=CurrentTokenString;
+      tsqlSymbolString,
+      tsqlIdentifier : Result.NewValue:=CurrentTokenString;
+    else
+      expect([tsqlSemiColon,tsqlTerminator,tsqlunknown, tsqlSymbolString]);
+    end;
+    GetNextToken;
+    // Next token depends on whether an alternative token is in effect...
+    if Scanner.AlternateTerminator<>'' then
+      Expect(tsqlTerminator)
+    else
+      Expect(tsqlSEMICOLON);
+    if Result.NewValue=TokenInfos[tsqlSEMICOLON] then
+      FScanner.AlternateTerminator:=''
+    else
+      FScanner.AlternateTerminator:=Result.NewValue;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
 
 function TSQLParser.ParseSecondaryFile(AParent: TSQLElement) : TSQLDatabaseFileInfo;
 
@@ -3163,22 +3247,42 @@ begin
 
 end;
 
-function TSQLParser.ParseCreateStatement(AParent: TSQLElement; IsAlter: Boolean
-  ): TSQLCreateOrAlterStatement;
+function TSQLParser.ParseCreateStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
+
+var
+  Tok : TSQLToken;
+  isOrAlter : Boolean;
+  isRecreate : Boolean;
+
 begin
-  Case GetNextToken of
+  isRecreate:=CurrentToken=tsqlRecreate;
+  tok:=GetNextToken;
+  isOrAlter:=tok=tsqlOR;
+  if isOrAlter then
+    begin
+    GetNextToken;
+    Consume(tsqlAlter);
+    if Not (CurrentToken in [tsqlProcedure,tsqlTrigger]) then
+      Expect([tsqlProcedure,tsqlTrigger]);
+    end;
+  if isRecreate then
+    Expect([tsqlProcedure,tsqlTable,tsqlView]);
+  Case CurrentToken of
     tsqlTable      :  if IsAlter then
                         Result:=ParseAlterTableStatement(AParent)
                       else
                         Result:=ParseCreateTableStatement(AParent);
 
     tsqlUnique,
+    tsqlDesc,
+    tsqlAsc,
     tsqlAscending,
     tsqlDescending,
     tsqlIndex      : Result:=ParseCreateIndexStatement(AParent,IsAlter);
     tsqlView       : Result:=ParseCreateViewStatement(AParent,IsAlter);
     tsqlProcedure  : Result:=ParseCreateProcedureStatement(AParent,IsAlter);
     tsqlDomain     : Result:=ParseCreateDomainStatement(AParent,IsAlter);
+    tsqlSequence,
     tsqlGenerator  : Result:=ParseCreateGeneratorStatement(AParent,IsAlter);
     tsqlException  : Result:=ParseCreateExceptionStatement(AParent,IsAlter);
     tsqlTrigger    : Result:=ParseCreateTriggerStatement(AParent,IsAlter);
@@ -3192,6 +3296,8 @@ begin
   else
      Error(SErrExpectedDBObject,[CurrentTokenString]);
   end;
+  Result.IsCreateOrAlter:=isOrAlter;
+  Result.isRecreate:=IsRecreate;
 end;
 
 function TSQLParser.ParseDropStatement(AParent: TSQLElement
@@ -3377,6 +3483,11 @@ begin
   Consume(tsqlSet);
   Case CurrentToken of
     tsqlGenerator : Result:=ParseSetGeneratorStatement(AParent); //SET GENERATOR
+    tsqlTerm :
+      if poAllowSetTerm in Foptions then
+         Result:=ParseSetTermStatement(AParent) //SET term
+      else
+         UnexpectedToken;
   else
     // For the time being
     UnexpectedToken;
@@ -3571,6 +3682,8 @@ begin
           UnexpectedToken;
         CreateGrantee(true,TSQLProcedureGrantee);
         end;
+    else
+      Expect([tsqlUser, tsqlIdentifier, TsqlGroup, TsqlPublic,TsqlTrigger, TsqlView, TsqlProcedure]);
     end;
   Until (GetNextToken<>tsqlComma);
 
@@ -3878,6 +3991,7 @@ begin
     tsqlUpdate : Result:=ParseUpdateStatement(Nil);
     tsqlInsert : Result:=ParseInsertStatement(Nil);
     tsqlDelete : Result:=ParseDeleteStatement(Nil);
+    tsqlReCreate,
     tsqlCreate,
     tsqlAlter : Result:=ParseCreateStatement(Nil,(tsqlAlter=CurrentToken));
     tsqlDrop  : Result:=ParseDropStatement(Nil);
@@ -3893,7 +4007,7 @@ begin
   else
     UnexpectedToken;
   end;
-  if Not (CurrentToken in [tsqlEOF,tsqlSemicolon]) then
+  if Not (CurrentToken in [tsqlEOF,tsqlSemicolon,tsqlTerminator]) then
     begin
     FreeAndNil(Result);
     if (CurrentToken=tsqlBraceClose) then
@@ -3902,12 +4016,28 @@ begin
     end;
 end;
 
-function TSQLParser.ParseScript(AllowPartial : Boolean = False): TSQLElementList;
+function TSQLParser.Parse(aOptions: TParserOptions): TSQLElement;
+begin
+  FOptions:=aOptions;
+  Result:=Parse();
+end;
+
+function TSQLParser.ParseScript(AllowPartial : Boolean): TSQLElementList;
+
+begin
+  if AllowPartial then
+    Result:=ParseScript([poPartial])
+  else
+    Result:=ParseScript([])
+end;
+
+Function TSQLParser.ParseScript(aOptions : TParserOptions = []) : TSQLElementList;
 
 var
   E : TSQLElement;
 
 begin
+  Foptions:=aOptions;
   Result:=TSQLElementList.Create(True);
   try
     E:=Parse;
@@ -3917,7 +4047,7 @@ begin
       E:=Parse;
       end;
   except
-    If Not AllowPartial then
+    If Not (poPartial in Options) then
       begin
       FreeAndNil(Result);
       Raise;

+ 17 - 10
packages/fcl-db/src/sql/fpsqlscanner.pp

@@ -44,7 +44,7 @@ type
    tsqlIntegerNumber,tsqlFloatNumber,tsqlComment,
    tsqlBraceOpen,tsqlBraceClose,tsqlSquareBraceOpen,tsqlSquareBraceClose,
    tsqlPlaceHolder {question mark},
-   tsqlCOMMA,tsqlCOLON,tsqlDOT,tsqlSEMICOLON,
+   tsqlCOMMA,tsqlCOLON,tsqlDOT,tsqlSEMICOLON,tsqlTerminator,
    tsqlGT,tsqlLT,tsqlPLUS,tsqlMINUS,tsqlMUL,tsqlDIV,tsqlConcatenate,
    tsqlEQ,tsqlGE,tsqlLE,tsqlNE,
    { Reserved words/keywords start here. They must be last }
@@ -70,13 +70,13 @@ type
    tSQLTABLE, tsqlText, tsqlTrigger, tsqlTime, tsqlTimeStamp, tsqlType, tsqlTo, tsqlTransaction, tsqlThen,
    tsqlUNION, tsqlUPDATE, tsqlUPPER,  tsqlUNIQUE, tsqlUSER,
    tsqlValue, tsqlVALUES, tsqlVARIABLE,  tsqlVIEW, tsqlVARCHAR,TSQLVARYING,
-   tsqlWHERE, tsqlWITH, tsqlWHILE, tsqlWork, tsqlWhen
+   tsqlWHERE, tsqlWITH, tsqlWHILE, tsqlWork, tsqlWhen,tsqlSequence,tsqlRestart,tsqlrecreate,tsqlterm
  );
    TSQLTokens = set of TSQLToken;
 
 const
   FirstKeyword = tsqlAll;
-  LastKeyWord = tsqlWhen;
+  LastKeyWord = tsqlTerm;
   sqlComparisons = [tsqleq,tsqlGE,tsqlLE,tsqlNE,tsqlGT,tsqlLT,tsqlIn,tsqlIS,
                     tsqlbetween,tsqlLike,tsqlContaining,tsqlStarting,tsqlNOT];
   sqlInvertableComparisons = [tsqlLike,tsqlContaining,tsqlStarting,tsqlIN,tsqlIS, tsqlBetween];
@@ -90,7 +90,8 @@ const
        'symbol string',
        'integer number','float number', 'comment',
        '(',')', '[',']',
-       '?',',',':','.',';','>','<',
+       '?',',',':','.',';','',
+       '>','<',
        '+','-','*','/','||',
        '=','>=','<=','<>',
        // Identifiers last:
@@ -115,7 +116,7 @@ const
        'TABLE', 'TEXT', 'TRIGGER', 'TIME', 'TIMESTAMP', 'TYPE', 'TO', 'TRANSACTION', 'THEN',
        'UNION', 'UPDATE', 'UPPER', 'UNIQUE', 'USER',
        'VALUE','VALUES','VARIABLE', 'VIEW','VARCHAR','VARYING',
-       'WHERE', 'WITH', 'WHILE','WORK','WHEN'
+       'WHERE', 'WITH', 'WHILE','WORK','WHEN','SEQUENCE','RESTART','RECREATE','TERM'
   );
 
 Type
@@ -166,9 +167,8 @@ Type
 
   TSQLScanner = class
   private
+    FAlternateTerminator: String;
     FOptions: TSQLScannerOptions;
-    FReturnComments: Boolean;
-    FReturnWhiteSpace: Boolean;
     FSourceFile: TLineReader;
     FSourceFilename: string;
     FCurRow: Integer;
@@ -219,6 +219,7 @@ Type
     property CurToken: TSQLToken read FCurToken;
     property CurTokenString: string read FCurTokenString;
     Property ExcludeKeywords : TStrings Read GetExcludeKeywords Write SetExcludeKeywords;
+    Property AlternateTerminator : String Read FAlternateTerminator Write FAlternateTerminator;
   end;
 
 
@@ -240,6 +241,7 @@ Var
 begin
   For T:=FirstKeyword to LastKeyWord do
     IdentifierTokens[T]:=T;
+  IdentifierTokensOK:=True;
 end;
 
 constructor TFileLineReader.Create(const AFilename: string);
@@ -479,7 +481,7 @@ Var
   Delim : Char;
   TokenStart : PChar;
   Len,OLen : Integer;
-  S : String;
+  S : UnicodeString;
 
   Procedure AppendBufToTokenString(DoNextToken : Boolean);
 
@@ -653,7 +655,10 @@ begin
     BuildKeyWords;
   P:=FKeyWords.Find(S);
   If (P<>Nil) then
-    Result:=P^; //keyword found
+    Result:=P^ //keyword found
+  else if (AlternateTerminator<>'') and (S=AlternateTerminator) then
+    Result:=tsqlTerminator;
+
   { I:=FirstKeyword;
   While (Result=tsqlIdentifier) and (I<=Lastkeyword) do
     begin
@@ -687,6 +692,8 @@ begin
     result:=tsqlSymbolString;
     SetLength(FCurTokenString,Len);
     Move(TokenStart^,FCurTokenString[1],Len);
+    if (AlternateTerminator<>'') and (CurtokenString=AlternateTerminator) then
+      Exit(tsqlTerminator);
 
     // Check if this is a keyword or identifier/literal
     // Probably not (due to naming rules) but it doesn't hurt
@@ -950,7 +957,7 @@ Var
 
 begin
   FPos:=FBufPos;
-  SetLength(Result,0);
+  Result:='';
   Repeat
     PRun:=@Buffer[FBufPos];
     While (FBufPos<FBufLen) and Not (PRun^ in [10,13]) do

+ 99 - 13
packages/fcl-db/src/sql/fpsqltree.pp

@@ -511,10 +511,12 @@ Type
                   sdtChar,sdtVarChar, sdtNChar, sdtNVarChar, sdtCstring,
                   sdtBlob);
 
+  TArrayDim = Array[1..2] of Integer;
+  TArrayDims = Array of TArrayDim;
 
   TSQLTypeDefinition = Class(TSQLElement)
   private
-    FArrayDim: Integer;
+    FArrayDims: TArrayDims;
     FBlobType: Integer;
     FByValue: Boolean;
     FCharSet: TSQLStringType;
@@ -534,7 +536,7 @@ Type
     Property TypeName : String Read FtypeName Write FTypeName;
     Property Len : Integer Read Flen Write Flen; // Length of string or precision for BCD
     Property Scale : Byte Read FScale Write FScale;
-    Property ArrayDim : Integer Read FArrayDim Write FArrayDim;
+    Property ArrayDims : TArrayDims Read FArrayDims Write FArrayDims;
     Property BlobType : Integer Read FBlobType Write FBlobType;
     Property NotNull : Boolean Read FNotNull Write FNotNull;
     Property Collation : TSQLCollation Read FCollation Write FCollation;
@@ -875,15 +877,24 @@ Type
   TSQLCreateOrAlterStatement = Class(TSQLDDLStatement)
   private
     FDBO: TSQLIdentifierName;
+    FIsCreateOrAlter: Boolean;
+    FIsReCreate: Boolean;
   Public
     Destructor Destroy; override;
     Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
     Property ObjectName : TSQLIdentifierName Read FDBO Write FDBO;
+    Property IsCreateOrAlter : Boolean Read FIsCreateOrAlter Write FIsCreateOrAlter;
+    Property IsRecreate : Boolean Read FIsReCreate Write FIsReCreate;
   end;
 
   { Generator }
 
-  TSQLCreateOrAlterGenerator = Class(TSQLCreateOrAlterStatement);
+  TSQLCreateOrAlterGenerator = Class(TSQLCreateOrAlterStatement)
+  Private
+    FIsIsSequence: Boolean;
+  public
+    Property IsSequence : Boolean Read FIsIsSequence Write FIsIsSequence;
+  end;
 
   { TSQLCreateGeneratorStatement }
 
@@ -892,6 +903,18 @@ Type
     Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
   end;
 
+
+  { TAlterGeneratorStatement }
+
+  TSQLAlterGeneratorStatement = Class(TSQLCreateOrAlterGenerator)
+  private
+    FHasRestart: Boolean;
+    FRestart: Int64;
+  Public
+    Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
+    Property Restart : Int64 Read FRestart Write FRestart;
+    Property HasRestart : Boolean Read FHasRestart Write FHasRestart;
+  end;
   { TSQLSetGeneratorStatement }
 
   TSQLSetGeneratorStatement = Class(TSQLCreateOrAlterGenerator)
@@ -1803,6 +1826,16 @@ Type
     Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
   end;
 
+  { TSQLSetTermStatement }
+
+  TSQLSetTermStatement = Class(TSQLStatement)
+  private
+    FNewValue: string;
+  Public
+    Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
+    Property NewValue : string Read FNewValue Write FNewValue;
+  end;
+
 Const
   CharTypes = [sdtChar,sdtVarChar,sdtNChar,sdtNVarChar,sdtCString];
   ExtractElementNames : Array[TSQLExtractElement] of String
@@ -1811,7 +1844,7 @@ Const
 // Format a SQL keyword according to OPTIONS
 Function SQLKeyWord(Const AWord : TSQLStringType; Options : TSQLFormatOptions) : TSQLStringType;
 Function SQLListSeparator(Options: TSQLFormatOptions) : String;
-Procedure GetSepPrefixIndent(DoNewLine,DoIndent : Boolean; Var Sep,Prefix : TSQLStringType; Var AIndent : Integer);
+Procedure GetSepPrefixIndent(DoNewLine,DoIndent : Boolean; Out Sep,Prefix : TSQLStringType; Out AIndent : Integer);
 Function SQLFormatString(Const AValue : TSQLStringType; Options : TSQLFormatOptions) : TSQLStringType;
 
 implementation
@@ -1848,7 +1881,7 @@ begin
     Delete(Result,Length(Result),1);
 end;
 
-Procedure GetSepPrefixIndent(DoNewLine,DoIndent : Boolean; Var Sep,Prefix : TSQLStringType; Var AIndent : Integer);
+Procedure GetSepPrefixIndent(DoNewLine,DoIndent : Boolean; Out Sep,Prefix : TSQLStringType; Out AIndent : Integer);
 
 begin
   Prefix:='';
@@ -1866,6 +1899,20 @@ begin
     Sep:=', ';
 end;
 
+{ TSQLSetTermStatement }
+
+function TSQLSetTermStatement.GetAsSQL(Options: TSQLFormatOptions; AIndent: Integer): TSQLStringType;
+begin
+  Result:='SET TERM '+NewValue;
+end;
+
+{ TSQLAlterGeneratorStatement }
+
+function TSQLAlterGeneratorStatement.GetAsSQL(Options: TSQLFormatOptions; AIndent: Integer): TSQLStringType;
+begin
+  Result:=inherited GetAsSQL(Options, AIndent);
+end;
+
 { TSQLSetISQLStatement }
 
 function TSQLSetISQLStatement.GetAsSQL(Options: TSQLFormatOptions;
@@ -2195,6 +2242,9 @@ Var
              'DECIMAL','NUMERIC','DATE','TIMESTAMP','TIME',
              'CHAR','VARCHAR','NATIONAL CHARACTER','NATIONAL CHARACTER VARYING','CSTRING',
              'BLOB');
+Var
+  D : TArrayDim;
+  I : integer;
 
 begin
   If DataType=sdtDomain then
@@ -2219,8 +2269,21 @@ begin
     end;
   If (CharSet<>'') then
     Result:=Result+SQLKeyWord(' CHARACTER SET ',Options)+CharSet;
-  If (ArrayDim<>0) then
-     Result:=Result+Format(' [%d]',[ArrayDim]);
+  If (Length(ArrayDims)>0) then
+     begin
+     Result:=Result+'[';
+     For I:=0 to Length(ArrayDims)-1  do
+       begin
+       If I>0 then
+           Result:=Result+',';
+       D:=ArrayDims[I];
+       if D[1]<>1 then
+         Result:=Result+Format('%d:%d',[D[1],D[2]])
+       else
+         Result:=Result+Format('%d',[D[1],D[2]]);
+       end;
+     Result:=Result+']';
+     end;
   If Assigned(FDefault) then
     Result:=Result+SQLKeyWord(' DEFAULT ',Options)+DefaultValue.GetAsSQL(Options,AIndent);
   If NotNull then
@@ -2497,7 +2560,13 @@ begin
 end;
 
 destructor TSQLCreateTableStatement.Destroy;
+
+Var
+  N : String;
+
 begin
+  N:=Self.ObjectName.Name;
+  Writeln(N);
   FreeAndNil(FexternalFile);
   FreeAndNil(FFieldDefs);
   FreeAndNil(FConstraints);
@@ -2531,7 +2600,10 @@ begin
     Result:=' ('+sLineBreak+Result+')'
   else
     Result:=' ('+Result+')';
-  S:=SQLKeyWord('CREATE TABLE ',Options)+inherited GetAsSQL(Options, AIndent);
+  S:='CREATE';
+  if IsRecreate then
+    S:='RE'+S;
+  S:=SQLKeyWord(S+' TABLE ',Options)+inherited GetAsSQL(Options, AIndent);
   If Assigned(FExternalFile) then
     S:=S+SQLKeyWord(' EXTERNAL FILE ',Options)+ExternalFileName.GetAsSQL(Options,AIndent);
   Result:=S+Result;
@@ -3089,6 +3161,7 @@ function TSQLAggregateFunctionExpression.GetAsSQL(Options: TSQLFormatOptions;
 
 Const
   OpCodes : Array[TSQLAggregateFunction] of string = ('COUNT','SUM','AVG','MAX','MIN');
+
 Var
   E : TSQLStringType;
 
@@ -3098,6 +3171,8 @@ begin
     aoAsterisk : E:='*';
     aoAll      : E:=SQLKeyword('ALL',Options);
     aoDistinct : E:=SQLKeyWord('DISTINCT',Options);
+  else
+    E:='';
   end;
   If Assigned(FExpression) and (Option<>aoAsterisk) then
     begin
@@ -3567,6 +3642,8 @@ begin
   Result:='';
   If Self is TSQLAlterProcedureStatement then
     Result:=SQLKeyword('ALTER ',Options)
+  else if IsRecreate then
+    Result:=SQLKeyword('RECREATE ',Options)
   else
     Result:=SQLKeyword('CREATE ',Options);
   Result:=Result+SQLKeyWord('PROCEDURE ',Options);
@@ -3653,7 +3730,7 @@ function TSQLStatementBlock.GetAsSQL(Options: TSQLFormatOptions;
   AIndent: Integer): TSQLStringType;
 
 Var
-  I,J : Integer;
+  I: Integer;
   S : String;
 begin
   S:='';
@@ -3721,6 +3798,7 @@ Var
   DoNewLine : Boolean;
 
 begin
+
   S:='';
   Result:=SQLKeyWord('FOR ',Options);
   If Assigned(FSelect) then
@@ -3930,8 +4008,7 @@ Const
 
 Var
   A : Boolean;
-  S,Sep : TSQLStringType;
-  I : Integer;
+  S: TSQLStringType;
   O : TTriggerOperation;
 
 begin
@@ -4180,8 +4257,13 @@ end;
 
 function TSQLCreateGeneratorStatement.GetAsSQL(Options: TSQLFormatOptions;
   AIndent: Integer): TSQLStringType;
+
 begin
-  Result:=SQLKeyWord('CREATE GENERATOR ',Options)+Inherited GetAsSQL(Options, AIndent);
+  if IsSequence then
+    Result:=SQLKeyWord('CREATE SEQUENCE ',Options)
+  else
+    Result:=SQLKeyWord('CREATE GENERATOR ',Options);
+  Result:=Result+Inherited GetAsSQL(Options, AIndent);
 end;
 
 { TSQLCreateRoleStatement }
@@ -4301,7 +4383,11 @@ Var
   I : Integer;
 
 begin
-  Result:=SQLKeyWord('CREATE VIEW ',Options)+inherited GetAsSQL(Options, AIndent);
+  if IsRecreate then
+    Result:=SQLKeyWord('RECREATE VIEW ',Options)
+  else
+    Result:=SQLKeyWord('CREATE VIEW ',Options);
+  Result:=Result+inherited GetAsSQL(Options, AIndent);
   If (Fields.Count>0) then
     begin
     S:='';

+ 3 - 20
packages/fcl-db/tests/tcgensql.pas

@@ -19,7 +19,7 @@ unit tcgensql;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry,fpsqltree;
+  Classes, SysUtils, fpcunit, testregistry,fpsqltree;
 
 type
   TSQLDropStatementClass = Class of TSQLDropStatement;
@@ -196,10 +196,7 @@ procedure TTestGenerateSQL.AssertSQL(const AElement: TSQLElement;
   const ASQL: TSQLStringType; AOptions: TSQLFormatOptions = []);
 
 Var
-  S,S2 : TSQLStringType;
-  L : TStringList;
-  I : Integer;
-
+  S: TSQLStringType;
 begin
   S:=AElement.GetAsSQL(AOptions);
   AssertEquals('Correct SQL',ASQL,S);
@@ -1802,7 +1799,6 @@ procedure TTestGenerateSQL.TestBlock;
 
 Var
   B,B2 : TSQLStatementBlock;
-  S : TSQLExitStatement;
   L : TSQLSelectStatement;
 
 begin
@@ -2275,10 +2271,8 @@ procedure TTestGenerateSQL.TestGrantTable;
 
 Var
   G : TSQLTableGrantStatement;
-  U : TSQLUserGrantee;
+  {%H-}U : TSQLUserGrantee;
   PU : TSQLColumnPrivilege;
-  PG : TSQLProcedureGrantee;
-
 begin
   G:=TSQLTableGrantStatement.Create(Nil);
   G.TableName:=CreateIdentifier('A');
@@ -2355,10 +2349,6 @@ procedure TTestGenerateSQL.TestGrantProcedure;
 
 Var
   G : TSQLProcedureGrantStatement;
-  U : TSQLUserGrantee;
-  PU : TSQLColumnPrivilege;
-  PG : TSQLProcedureGrantee;
-
 begin
   G:=TSQLProcedureGrantStatement.Create(Nil);
   G.ProcedureName:=CreateIdentifier('A');
@@ -2390,8 +2380,6 @@ end;
 procedure TTestGenerateSQL.TestGrantRole;
 Var
   G : TSQLRoleGrantStatement;
-  U : TSQLUserGrantee;
-
 begin
   G:=TSQLRoleGrantStatement.Create(Nil);
   G.Roles.Add(CreateIdentifier('A'));
@@ -2412,10 +2400,7 @@ end;
 procedure TTestGenerateSQL.TestRevokeTable;
 Var
   G : TSQLTableRevokeStatement;
-  U : TSQLUserGrantee;
   PU : TSQLColumnPrivilege;
-  PG : TSQLProcedureGrantee;
-
 begin
   G:=TSQLTableRevokeStatement.Create(Nil);
   G.TableName:=CreateIdentifier('A');
@@ -2491,8 +2476,6 @@ end;
 procedure TTestGenerateSQL.TestRevokeProcedure;
 Var
   G : TSQLProcedureRevokeStatement;
-  PG : TSQLProcedureGrantee;
-
 begin
   G:=TSQLProcedureRevokeStatement.Create(Nil);
   G.ProcedureName:=CreateIdentifier('A');

+ 78 - 33
packages/fcl-db/tests/tcparser.pas

@@ -19,7 +19,7 @@ unit tcparser;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, fpsqltree, fpsqlscanner, fpsqlparser, testregistry;
+  Classes, SysUtils, fpcunit, fpsqltree, fpsqlscanner, fpsqlparser, testregistry;
 
 type
 
@@ -37,16 +37,18 @@ type
 
   TTestSQLParser = class(TTestCase)
   Private
+    FParserOptions: TParserOptions;
     FSource : TStringStream;
     FParser : TTestParser;
     FToFree : TSQLElement; //will be freed by test teardown
     FErrSource : string;
+    function GetParserOptions: TParserOptions;
   protected
     procedure AssertTypeDefaults(TD: TSQLTypeDefinition; Len: Integer=0);
     procedure TestStringDef(ASource: String; ExpectDT: TSQLDataType; ExpectLen: Integer; ExpectCharset : TSQLStringType='');
     function TestType(ASource : string; AFlags : TParseTypeFlags; AExpectedType : TSQLDataType) : TSQLTypeDefinition;
     function TestCheck(ASource : string; AExpectedConstraint : TSQLElementClass) : TSQLExpression;
-    procedure CreateParser(Const ASource : string);
+    procedure CreateParser(Const ASource : string; aOptions : TParserOptions = []);
     function CheckClass(E : TSQLElement; C : TSQLElementClass) : TSQLElement;
     procedure TestDropStatement(Const ASource : string;C : TSQLElementClass);
     function TestCreateStatement(Const ASource,AName : string;C: TSQLElementClass) : TSQLCreateOrAlterStatement;
@@ -81,6 +83,7 @@ type
     procedure SetUp; override;
     procedure TearDown; override;
     property Parser : TTestParser Read FParser;
+    property ParserOptions : TParserOptions Read GetParserOptions Write FParserOptions;
     property ToFree : TSQLElement Read FToFree Write FTofree;
   end;
 
@@ -107,9 +110,20 @@ type
   TTestGeneratorParser = Class(TTestSQLParser)
   Published
     procedure TestCreateGenerator;
+    procedure TestCreateSequence;
+    procedure TestAlterSequence;
     procedure TestSetGenerator;
   end;
 
+  { TTestSetTermParser }
+
+  TTestSetTermParser = Class(TTestSQLParser)
+  Published
+    procedure TestSetTermNoOption;
+    procedure TestSetTermOption;
+  end;
+
+
   { TTestRoleParser }
 
   TTestRoleParser = Class(TTestSQLParser)
@@ -660,6 +674,7 @@ type
     procedure TestParseStatementError;
     function TestStatement(Const ASource : String) : TSQLStatement;
     procedure TestStatementError(Const ASource : String);
+  Public
     property Statement : TSQLStatement Read FStatement;
   Published
     procedure TestException;
@@ -855,6 +870,21 @@ implementation
 
 uses typinfo;
 
+{ TTestSetTermParser }
+
+procedure TTestSetTermParser.TestSetTermNoOption;
+begin
+  FErrSource:='SET TERM ^ ;';
+  AssertException(ESQLParser,@TestParseError);
+end;
+
+procedure TTestSetTermParser.TestSetTermOption;
+begin
+  CreateParser('SET TERM ^ ;');
+  FToFree:=Parser.Parse([poAllowSetTerm]);
+  AssertEquals('Terminator set','^',Parser.Scanner.AlternateTerminator);
+end;
+
 { TTestGlobalParser }
 
 procedure TTestGlobalParser.TestEmpty;
@@ -904,12 +934,14 @@ begin
   FreeAndNil(FToFree);
 end;
 
-procedure TTestSQLParser.CreateParser(const ASource: string);
+procedure TTestSQLParser.CreateParser(const ASource: string; aOptions: TParserOptions = []);
 begin
   FSource:=TStringStream.Create(ASource);
+  FParserOptions:=aOptions;
   FParser:=TTestParser.Create(FSource);
 end;
 
+
 Function TTestSQLParser.CheckClass(E: TSQLElement; C: TSQLElementClass) : TSQLElement;
 begin
   AssertEquals(C,E.ClassType);
@@ -1062,9 +1094,6 @@ end;
 
 procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected,
   Actual: TTriggerOperations);
-Var
-  NE,NA : String;
-
 begin
   If Expected<>Actual then
     Fail(Amessage)
@@ -1270,13 +1299,21 @@ begin
   AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
 end;
 
+function TTestSQLParser.GetParserOptions: TParserOptions;
+begin
+  if Assigned(FParser) then
+    Result:=FParser.Options
+  else
+    Result:=FParserOptions;
+end;
+
 procedure TTestSQLParser.AssertTypeDefaults(TD : TSQLTypeDefinition;Len : Integer = 0);
 
 begin
   AssertNull(TD.DefaultValue);
   AssertNull(TD.Check);
   AssertNull(TD.Collation);
-  AssertEquals('Array dim 0',0,TD.ArrayDim);
+  AssertEquals('Array dim 0',0,Length(TD.ArrayDims));
   AssertEquals('Blob type 0',0,TD.BlobType);
   AssertEquals('Not required',False,TD.NotNull);
   AssertEquals('Length',Len,TD.Len);
@@ -1404,6 +1441,26 @@ begin
   TestCreateStatement('CREATE GENERATOR A','A',TSQLCreateGeneratorStatement);
 end;
 
+procedure TTestGeneratorParser.TestCreateSequence;
+
+Var
+  C : TSQLCreateOrAlterStatement;
+begin
+  C:=TestCreateStatement('CREATE SEQUENCE A','A',TSQLCreateGeneratorStatement);
+  AssertEquals('Sequence detected',True,TSQLCreateGeneratorStatement(c).IsSequence);
+end;
+
+procedure TTestGeneratorParser.TestAlterSequence;
+Var
+  C : TSQLCreateOrAlterStatement;
+  D : TSQLAlterGeneratorStatement absolute C;
+begin
+  C:=TestCreateStatement('ALTER SEQUENCE A RESTART WITH 100','A',TSQLAlterGeneratorStatement);
+  AssertEquals('Sequence detected',True,D.IsSequence);
+  AssertEquals('Sequence restart ',True,D.HasRestart);
+  AssertEquals('Sequence restart value',100,D.Restart);
+end;
+
 procedure TTestGeneratorParser.TestSetGenerator;
 
 Var
@@ -1611,7 +1668,9 @@ Var
 
 begin
   TD:=TestType('INT [3]',[],sdtInteger);
-  AssertEquals('Array of length 3',3,TD.ArrayDim);
+  AssertEquals('Array of length',1,Length(TD.ArrayDims));
+  AssertEquals('Upper bound',3,TD.ArrayDims[0][2]);
+  AssertEquals('Lower bound',1,TD.ArrayDims[0][1]);
   AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
 end;
 
@@ -1781,31 +1840,26 @@ end;
 
 procedure TTestTypeParser.TestSmallInt;
 
-Var
-  TD : TSQLTypeDefinition;
 begin
-  TD:=TestType('SMALLINT',[],sdtSmallint);
+  TestType('SMALLINT',[],sdtSmallint);
 end;
 
 procedure TTestTypeParser.TestFloat;
-Var
-  TD : TSQLTypeDefinition;
+
 begin
-  TD:=TestType('FLOAT',[],sdtFloat);
+  TestType('FLOAT',[],sdtFloat);
 end;
 
 procedure TTestTypeParser.TestDoublePrecision;
-var
-  TD : TSQLTypeDefinition;
+
 begin
-  TD:=TestType('DOUBLE PRECISION',[],sdtDoublePrecision);
+  TestType('DOUBLE PRECISION',[],sdtDoublePrecision);
 end;
 
 procedure TTestTypeParser.TestDoublePrecisionDefault;
-var
-  TD : TSQLTypeDefinition;
+
 begin
-  TD:=TestType('DOUBLE PRECISION DEFAULT 0',[],sdtDoublePrecision);
+  TestType('DOUBLE PRECISION DEFAULT 0',[],sdtDoublePrecision);
 end;
 
 procedure TTestTypeParser.TestBlobError1;
@@ -4736,7 +4790,6 @@ end;
 procedure TTestSelectParser.TestWhereExists;
 
 Var
-  F : TSQLSelectField;
   E : TSQLExistsExpression;
   S : TSQLSelectStatement;
 
@@ -6163,19 +6216,14 @@ end;
 
 procedure TTestProcedureStatement.TestExit;
 
-Var
-  E : TSQLExitStatement;
 begin
-  E:=TSQLExitStatement(CheckClass(TestStatement('EXIT'),TSQLExitStatement));
+  CheckClass(TestStatement('EXIT'),TSQLExitStatement);
 end;
 
 procedure TTestProcedureStatement.TestSuspend;
 
-Var
-  E : TSQLSuspendStatement;
-
 begin
-  E:=TSQLSuspendStatement(CheckClass(TestStatement('Suspend'),TSQLSuspendStatement));
+  CheckClass(TestStatement('Suspend'),TSQLSuspendStatement);
 end;
 
 procedure TTestProcedureStatement.TestEmptyBlock;
@@ -7594,8 +7642,6 @@ end;
 procedure TTestGrantParser.TestPublicPrivilege;
 Var
   t : TSQLTableGrantStatement;
-  P : TSQLPublicGrantee;
-
 begin
   TestGrant('GRANT SELECT ON A TO PUBLIC');
   T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
@@ -8051,8 +8097,6 @@ end;
 procedure TTestRevokeParser.TestPublicPrivilege;
 Var
   t : TSQLTableRevokeStatement;
-  P : TSQLPublicGrantee;
-
 begin
   TestRevoke('Revoke SELECT ON A FROM PUBLIC');
   T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
@@ -8171,6 +8215,7 @@ initialization
                  TTestDeclareExternalFunctionParser,
                  TTestGrantParser,
                  TTestRevokeParser,
-                 TTestGlobalParser]);
+                 TTestGlobalParser,
+                 TTestSetTermParser]);
 end.
 

+ 33 - 1
packages/fcl-db/tests/tcsqlscanner.pas

@@ -19,7 +19,7 @@ unit tcsqlscanner;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, fpsqlscanner;
+  Classes, SysUtils, fpcunit, testregistry, fpsqlscanner;
 
 type
 
@@ -223,6 +223,11 @@ type
     procedure TestWhile;
     procedure TestWith;
     procedure TestWork;
+    procedure TestTerm;
+    procedure TestTermExclude;
+    procedure TestRecreate;
+    procedure TestRestart;
+    procedure TestSequence;
     Procedure Test2Words;
     procedure Test3Words;
     procedure TestIdentifier;
@@ -1350,6 +1355,33 @@ begin
   CheckToken(tsqlWork,'work');
 end;
 
+procedure TTestSQLScanner.TestTerm;
+begin
+  CheckToken(tsqlTerm,'term');
+end;
+
+procedure TTestSQLScanner.TestTermExclude;
+begin
+  CreateScanner('term');
+  FScanner.Excludekeywords.Add('term');
+  AssertEquals('Term is identifier',tsqlIdentifier,FScanner.FetchToken);
+end;
+
+procedure TTestSQLScanner.TestRecreate;
+begin
+  CheckToken(tsqlRecreate,'recreate');
+end;
+
+procedure TTestSQLScanner.TestRestart;
+begin
+  CheckToken(tsqlRestart,'restart');
+end;
+
+procedure TTestSQLScanner.TestSequence;
+begin
+  CheckToken(tsqlSequence,'sequence');
+end;
+
 procedure TTestSQLScanner.CheckTokens(ASource : String; ATokens : Array of TSQLToken);
 
 Var