Pārlūkot izejas kodu

* Fix bug ID #32625: added several firebird constructs

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

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

@@ -44,7 +44,7 @@ type
    tsqlIntegerNumber,tsqlFloatNumber,tsqlComment,
    tsqlIntegerNumber,tsqlFloatNumber,tsqlComment,
    tsqlBraceOpen,tsqlBraceClose,tsqlSquareBraceOpen,tsqlSquareBraceClose,
    tsqlBraceOpen,tsqlBraceClose,tsqlSquareBraceOpen,tsqlSquareBraceClose,
    tsqlPlaceHolder {question mark},
    tsqlPlaceHolder {question mark},
-   tsqlCOMMA,tsqlCOLON,tsqlDOT,tsqlSEMICOLON,
+   tsqlCOMMA,tsqlCOLON,tsqlDOT,tsqlSEMICOLON,tsqlTerminator,
    tsqlGT,tsqlLT,tsqlPLUS,tsqlMINUS,tsqlMUL,tsqlDIV,tsqlConcatenate,
    tsqlGT,tsqlLT,tsqlPLUS,tsqlMINUS,tsqlMUL,tsqlDIV,tsqlConcatenate,
    tsqlEQ,tsqlGE,tsqlLE,tsqlNE,
    tsqlEQ,tsqlGE,tsqlLE,tsqlNE,
    { Reserved words/keywords start here. They must be last }
    { Reserved words/keywords start here. They must be last }
@@ -70,13 +70,13 @@ type
    tSQLTABLE, tsqlText, tsqlTrigger, tsqlTime, tsqlTimeStamp, tsqlType, tsqlTo, tsqlTransaction, tsqlThen,
    tSQLTABLE, tsqlText, tsqlTrigger, tsqlTime, tsqlTimeStamp, tsqlType, tsqlTo, tsqlTransaction, tsqlThen,
    tsqlUNION, tsqlUPDATE, tsqlUPPER,  tsqlUNIQUE, tsqlUSER,
    tsqlUNION, tsqlUPDATE, tsqlUPPER,  tsqlUNIQUE, tsqlUSER,
    tsqlValue, tsqlVALUES, tsqlVARIABLE,  tsqlVIEW, tsqlVARCHAR,TSQLVARYING,
    tsqlValue, tsqlVALUES, tsqlVARIABLE,  tsqlVIEW, tsqlVARCHAR,TSQLVARYING,
-   tsqlWHERE, tsqlWITH, tsqlWHILE, tsqlWork, tsqlWhen
+   tsqlWHERE, tsqlWITH, tsqlWHILE, tsqlWork, tsqlWhen,tsqlSequence,tsqlRestart,tsqlrecreate,tsqlterm
  );
  );
    TSQLTokens = set of TSQLToken;
    TSQLTokens = set of TSQLToken;
 
 
 const
 const
   FirstKeyword = tsqlAll;
   FirstKeyword = tsqlAll;
-  LastKeyWord = tsqlWhen;
+  LastKeyWord = tsqlTerm;
   sqlComparisons = [tsqleq,tsqlGE,tsqlLE,tsqlNE,tsqlGT,tsqlLT,tsqlIn,tsqlIS,
   sqlComparisons = [tsqleq,tsqlGE,tsqlLE,tsqlNE,tsqlGT,tsqlLT,tsqlIn,tsqlIS,
                     tsqlbetween,tsqlLike,tsqlContaining,tsqlStarting,tsqlNOT];
                     tsqlbetween,tsqlLike,tsqlContaining,tsqlStarting,tsqlNOT];
   sqlInvertableComparisons = [tsqlLike,tsqlContaining,tsqlStarting,tsqlIN,tsqlIS, tsqlBetween];
   sqlInvertableComparisons = [tsqlLike,tsqlContaining,tsqlStarting,tsqlIN,tsqlIS, tsqlBetween];
@@ -90,7 +90,8 @@ const
        'symbol string',
        'symbol string',
        'integer number','float number', 'comment',
        'integer number','float number', 'comment',
        '(',')', '[',']',
        '(',')', '[',']',
-       '?',',',':','.',';','>','<',
+       '?',',',':','.',';','',
+       '>','<',
        '+','-','*','/','||',
        '+','-','*','/','||',
        '=','>=','<=','<>',
        '=','>=','<=','<>',
        // Identifiers last:
        // Identifiers last:
@@ -115,7 +116,7 @@ const
        'TABLE', 'TEXT', 'TRIGGER', 'TIME', 'TIMESTAMP', 'TYPE', 'TO', 'TRANSACTION', 'THEN',
        'TABLE', 'TEXT', 'TRIGGER', 'TIME', 'TIMESTAMP', 'TYPE', 'TO', 'TRANSACTION', 'THEN',
        'UNION', 'UPDATE', 'UPPER', 'UNIQUE', 'USER',
        'UNION', 'UPDATE', 'UPPER', 'UNIQUE', 'USER',
        'VALUE','VALUES','VARIABLE', 'VIEW','VARCHAR','VARYING',
        'VALUE','VALUES','VARIABLE', 'VIEW','VARCHAR','VARYING',
-       'WHERE', 'WITH', 'WHILE','WORK','WHEN'
+       'WHERE', 'WITH', 'WHILE','WORK','WHEN','SEQUENCE','RESTART','RECREATE','TERM'
   );
   );
 
 
 Type
 Type
@@ -166,9 +167,8 @@ Type
 
 
   TSQLScanner = class
   TSQLScanner = class
   private
   private
+    FAlternateTerminator: String;
     FOptions: TSQLScannerOptions;
     FOptions: TSQLScannerOptions;
-    FReturnComments: Boolean;
-    FReturnWhiteSpace: Boolean;
     FSourceFile: TLineReader;
     FSourceFile: TLineReader;
     FSourceFilename: string;
     FSourceFilename: string;
     FCurRow: Integer;
     FCurRow: Integer;
@@ -219,6 +219,7 @@ Type
     property CurToken: TSQLToken read FCurToken;
     property CurToken: TSQLToken read FCurToken;
     property CurTokenString: string read FCurTokenString;
     property CurTokenString: string read FCurTokenString;
     Property ExcludeKeywords : TStrings Read GetExcludeKeywords Write SetExcludeKeywords;
     Property ExcludeKeywords : TStrings Read GetExcludeKeywords Write SetExcludeKeywords;
+    Property AlternateTerminator : String Read FAlternateTerminator Write FAlternateTerminator;
   end;
   end;
 
 
 
 
@@ -240,6 +241,7 @@ Var
 begin
 begin
   For T:=FirstKeyword to LastKeyWord do
   For T:=FirstKeyword to LastKeyWord do
     IdentifierTokens[T]:=T;
     IdentifierTokens[T]:=T;
+  IdentifierTokensOK:=True;
 end;
 end;
 
 
 constructor TFileLineReader.Create(const AFilename: string);
 constructor TFileLineReader.Create(const AFilename: string);
@@ -479,7 +481,7 @@ Var
   Delim : Char;
   Delim : Char;
   TokenStart : PChar;
   TokenStart : PChar;
   Len,OLen : Integer;
   Len,OLen : Integer;
-  S : String;
+  S : UnicodeString;
 
 
   Procedure AppendBufToTokenString(DoNextToken : Boolean);
   Procedure AppendBufToTokenString(DoNextToken : Boolean);
 
 
@@ -653,7 +655,10 @@ begin
     BuildKeyWords;
     BuildKeyWords;
   P:=FKeyWords.Find(S);
   P:=FKeyWords.Find(S);
   If (P<>Nil) then
   If (P<>Nil) then
-    Result:=P^; //keyword found
+    Result:=P^ //keyword found
+  else if (AlternateTerminator<>'') and (S=AlternateTerminator) then
+    Result:=tsqlTerminator;
+
   { I:=FirstKeyword;
   { I:=FirstKeyword;
   While (Result=tsqlIdentifier) and (I<=Lastkeyword) do
   While (Result=tsqlIdentifier) and (I<=Lastkeyword) do
     begin
     begin
@@ -687,6 +692,8 @@ begin
     result:=tsqlSymbolString;
     result:=tsqlSymbolString;
     SetLength(FCurTokenString,Len);
     SetLength(FCurTokenString,Len);
     Move(TokenStart^,FCurTokenString[1],Len);
     Move(TokenStart^,FCurTokenString[1],Len);
+    if (AlternateTerminator<>'') and (CurtokenString=AlternateTerminator) then
+      Exit(tsqlTerminator);
 
 
     // Check if this is a keyword or identifier/literal
     // Check if this is a keyword or identifier/literal
     // Probably not (due to naming rules) but it doesn't hurt
     // Probably not (due to naming rules) but it doesn't hurt
@@ -950,7 +957,7 @@ Var
 
 
 begin
 begin
   FPos:=FBufPos;
   FPos:=FBufPos;
-  SetLength(Result,0);
+  Result:='';
   Repeat
   Repeat
     PRun:=@Buffer[FBufPos];
     PRun:=@Buffer[FBufPos];
     While (FBufPos<FBufLen) and Not (PRun^ in [10,13]) do
     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,
                   sdtChar,sdtVarChar, sdtNChar, sdtNVarChar, sdtCstring,
                   sdtBlob);
                   sdtBlob);
 
 
+  TArrayDim = Array[1..2] of Integer;
+  TArrayDims = Array of TArrayDim;
 
 
   TSQLTypeDefinition = Class(TSQLElement)
   TSQLTypeDefinition = Class(TSQLElement)
   private
   private
-    FArrayDim: Integer;
+    FArrayDims: TArrayDims;
     FBlobType: Integer;
     FBlobType: Integer;
     FByValue: Boolean;
     FByValue: Boolean;
     FCharSet: TSQLStringType;
     FCharSet: TSQLStringType;
@@ -534,7 +536,7 @@ Type
     Property TypeName : String Read FtypeName Write FTypeName;
     Property TypeName : String Read FtypeName Write FTypeName;
     Property Len : Integer Read Flen Write Flen; // Length of string or precision for BCD
     Property Len : Integer Read Flen Write Flen; // Length of string or precision for BCD
     Property Scale : Byte Read FScale Write FScale;
     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 BlobType : Integer Read FBlobType Write FBlobType;
     Property NotNull : Boolean Read FNotNull Write FNotNull;
     Property NotNull : Boolean Read FNotNull Write FNotNull;
     Property Collation : TSQLCollation Read FCollation Write FCollation;
     Property Collation : TSQLCollation Read FCollation Write FCollation;
@@ -875,15 +877,24 @@ Type
   TSQLCreateOrAlterStatement = Class(TSQLDDLStatement)
   TSQLCreateOrAlterStatement = Class(TSQLDDLStatement)
   private
   private
     FDBO: TSQLIdentifierName;
     FDBO: TSQLIdentifierName;
+    FIsCreateOrAlter: Boolean;
+    FIsReCreate: Boolean;
   Public
   Public
     Destructor Destroy; override;
     Destructor Destroy; override;
     Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
     Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
     Property ObjectName : TSQLIdentifierName Read FDBO Write FDBO;
     Property ObjectName : TSQLIdentifierName Read FDBO Write FDBO;
+    Property IsCreateOrAlter : Boolean Read FIsCreateOrAlter Write FIsCreateOrAlter;
+    Property IsRecreate : Boolean Read FIsReCreate Write FIsReCreate;
   end;
   end;
 
 
   { Generator }
   { Generator }
 
 
-  TSQLCreateOrAlterGenerator = Class(TSQLCreateOrAlterStatement);
+  TSQLCreateOrAlterGenerator = Class(TSQLCreateOrAlterStatement)
+  Private
+    FIsIsSequence: Boolean;
+  public
+    Property IsSequence : Boolean Read FIsIsSequence Write FIsIsSequence;
+  end;
 
 
   { TSQLCreateGeneratorStatement }
   { TSQLCreateGeneratorStatement }
 
 
@@ -892,6 +903,18 @@ Type
     Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
     Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
   end;
   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 }
 
 
   TSQLSetGeneratorStatement = Class(TSQLCreateOrAlterGenerator)
   TSQLSetGeneratorStatement = Class(TSQLCreateOrAlterGenerator)
@@ -1803,6 +1826,16 @@ Type
     Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
     Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
   end;
   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
 Const
   CharTypes = [sdtChar,sdtVarChar,sdtNChar,sdtNVarChar,sdtCString];
   CharTypes = [sdtChar,sdtVarChar,sdtNChar,sdtNVarChar,sdtCString];
   ExtractElementNames : Array[TSQLExtractElement] of String
   ExtractElementNames : Array[TSQLExtractElement] of String
@@ -1811,7 +1844,7 @@ Const
 // Format a SQL keyword according to OPTIONS
 // Format a SQL keyword according to OPTIONS
 Function SQLKeyWord(Const AWord : TSQLStringType; Options : TSQLFormatOptions) : TSQLStringType;
 Function SQLKeyWord(Const AWord : TSQLStringType; Options : TSQLFormatOptions) : TSQLStringType;
 Function SQLListSeparator(Options: TSQLFormatOptions) : String;
 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;
 Function SQLFormatString(Const AValue : TSQLStringType; Options : TSQLFormatOptions) : TSQLStringType;
 
 
 implementation
 implementation
@@ -1848,7 +1881,7 @@ begin
     Delete(Result,Length(Result),1);
     Delete(Result,Length(Result),1);
 end;
 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
 begin
   Prefix:='';
   Prefix:='';
@@ -1866,6 +1899,20 @@ begin
     Sep:=', ';
     Sep:=', ';
 end;
 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 }
 { TSQLSetISQLStatement }
 
 
 function TSQLSetISQLStatement.GetAsSQL(Options: TSQLFormatOptions;
 function TSQLSetISQLStatement.GetAsSQL(Options: TSQLFormatOptions;
@@ -2195,6 +2242,9 @@ Var
              'DECIMAL','NUMERIC','DATE','TIMESTAMP','TIME',
              'DECIMAL','NUMERIC','DATE','TIMESTAMP','TIME',
              'CHAR','VARCHAR','NATIONAL CHARACTER','NATIONAL CHARACTER VARYING','CSTRING',
              'CHAR','VARCHAR','NATIONAL CHARACTER','NATIONAL CHARACTER VARYING','CSTRING',
              'BLOB');
              'BLOB');
+Var
+  D : TArrayDim;
+  I : integer;
 
 
 begin
 begin
   If DataType=sdtDomain then
   If DataType=sdtDomain then
@@ -2219,8 +2269,21 @@ begin
     end;
     end;
   If (CharSet<>'') then
   If (CharSet<>'') then
     Result:=Result+SQLKeyWord(' CHARACTER SET ',Options)+CharSet;
     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
   If Assigned(FDefault) then
     Result:=Result+SQLKeyWord(' DEFAULT ',Options)+DefaultValue.GetAsSQL(Options,AIndent);
     Result:=Result+SQLKeyWord(' DEFAULT ',Options)+DefaultValue.GetAsSQL(Options,AIndent);
   If NotNull then
   If NotNull then
@@ -2497,7 +2560,13 @@ begin
 end;
 end;
 
 
 destructor TSQLCreateTableStatement.Destroy;
 destructor TSQLCreateTableStatement.Destroy;
+
+Var
+  N : String;
+
 begin
 begin
+  N:=Self.ObjectName.Name;
+  Writeln(N);
   FreeAndNil(FexternalFile);
   FreeAndNil(FexternalFile);
   FreeAndNil(FFieldDefs);
   FreeAndNil(FFieldDefs);
   FreeAndNil(FConstraints);
   FreeAndNil(FConstraints);
@@ -2531,7 +2600,10 @@ begin
     Result:=' ('+sLineBreak+Result+')'
     Result:=' ('+sLineBreak+Result+')'
   else
   else
     Result:=' ('+Result+')';
     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
   If Assigned(FExternalFile) then
     S:=S+SQLKeyWord(' EXTERNAL FILE ',Options)+ExternalFileName.GetAsSQL(Options,AIndent);
     S:=S+SQLKeyWord(' EXTERNAL FILE ',Options)+ExternalFileName.GetAsSQL(Options,AIndent);
   Result:=S+Result;
   Result:=S+Result;
@@ -3089,6 +3161,7 @@ function TSQLAggregateFunctionExpression.GetAsSQL(Options: TSQLFormatOptions;
 
 
 Const
 Const
   OpCodes : Array[TSQLAggregateFunction] of string = ('COUNT','SUM','AVG','MAX','MIN');
   OpCodes : Array[TSQLAggregateFunction] of string = ('COUNT','SUM','AVG','MAX','MIN');
+
 Var
 Var
   E : TSQLStringType;
   E : TSQLStringType;
 
 
@@ -3098,6 +3171,8 @@ begin
     aoAsterisk : E:='*';
     aoAsterisk : E:='*';
     aoAll      : E:=SQLKeyword('ALL',Options);
     aoAll      : E:=SQLKeyword('ALL',Options);
     aoDistinct : E:=SQLKeyWord('DISTINCT',Options);
     aoDistinct : E:=SQLKeyWord('DISTINCT',Options);
+  else
+    E:='';
   end;
   end;
   If Assigned(FExpression) and (Option<>aoAsterisk) then
   If Assigned(FExpression) and (Option<>aoAsterisk) then
     begin
     begin
@@ -3567,6 +3642,8 @@ begin
   Result:='';
   Result:='';
   If Self is TSQLAlterProcedureStatement then
   If Self is TSQLAlterProcedureStatement then
     Result:=SQLKeyword('ALTER ',Options)
     Result:=SQLKeyword('ALTER ',Options)
+  else if IsRecreate then
+    Result:=SQLKeyword('RECREATE ',Options)
   else
   else
     Result:=SQLKeyword('CREATE ',Options);
     Result:=SQLKeyword('CREATE ',Options);
   Result:=Result+SQLKeyWord('PROCEDURE ',Options);
   Result:=Result+SQLKeyWord('PROCEDURE ',Options);
@@ -3653,7 +3730,7 @@ function TSQLStatementBlock.GetAsSQL(Options: TSQLFormatOptions;
   AIndent: Integer): TSQLStringType;
   AIndent: Integer): TSQLStringType;
 
 
 Var
 Var
-  I,J : Integer;
+  I: Integer;
   S : String;
   S : String;
 begin
 begin
   S:='';
   S:='';
@@ -3721,6 +3798,7 @@ Var
   DoNewLine : Boolean;
   DoNewLine : Boolean;
 
 
 begin
 begin
+
   S:='';
   S:='';
   Result:=SQLKeyWord('FOR ',Options);
   Result:=SQLKeyWord('FOR ',Options);
   If Assigned(FSelect) then
   If Assigned(FSelect) then
@@ -3930,8 +4008,7 @@ Const
 
 
 Var
 Var
   A : Boolean;
   A : Boolean;
-  S,Sep : TSQLStringType;
-  I : Integer;
+  S: TSQLStringType;
   O : TTriggerOperation;
   O : TTriggerOperation;
 
 
 begin
 begin
@@ -4180,8 +4257,13 @@ end;
 
 
 function TSQLCreateGeneratorStatement.GetAsSQL(Options: TSQLFormatOptions;
 function TSQLCreateGeneratorStatement.GetAsSQL(Options: TSQLFormatOptions;
   AIndent: Integer): TSQLStringType;
   AIndent: Integer): TSQLStringType;
+
 begin
 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;
 end;
 
 
 { TSQLCreateRoleStatement }
 { TSQLCreateRoleStatement }
@@ -4301,7 +4383,11 @@ Var
   I : Integer;
   I : Integer;
 
 
 begin
 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
   If (Fields.Count>0) then
     begin
     begin
     S:='';
     S:='';

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

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

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

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

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

@@ -19,7 +19,7 @@ unit tcsqlscanner;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, fpsqlscanner;
+  Classes, SysUtils, fpcunit, testregistry, fpsqlscanner;
 
 
 type
 type
 
 
@@ -223,6 +223,11 @@ type
     procedure TestWhile;
     procedure TestWhile;
     procedure TestWith;
     procedure TestWith;
     procedure TestWork;
     procedure TestWork;
+    procedure TestTerm;
+    procedure TestTermExclude;
+    procedure TestRecreate;
+    procedure TestRestart;
+    procedure TestSequence;
     Procedure Test2Words;
     Procedure Test2Words;
     procedure Test3Words;
     procedure Test3Words;
     procedure TestIdentifier;
     procedure TestIdentifier;
@@ -1350,6 +1355,33 @@ begin
   CheckToken(tsqlWork,'work');
   CheckToken(tsqlWork,'work');
 end;
 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);
 procedure TTestSQLScanner.CheckTokens(ASource : String; ATokens : Array of TSQLToken);
 
 
 Var
 Var