diff --git a/packages/fcl-db/src/sql/fpsqlparser.pas b/packages/fcl-db/src/sql/fpsqlparser.pas index 44c708c998..80737e3f40 100644 --- a/packages/fcl-db/src/sql/fpsqlparser.pas +++ b/packages/fcl-db/src/sql/fpsqlparser.pas @@ -49,19 +49,20 @@ Type FPeekTokenString: String; Procedure CheckEOF; protected - Procedure UnexpectedToken; overload; - Procedure UnexpectedToken(AExpected : TSQLTokens); overload; + procedure UnexpectedToken; overload; + procedure UnexpectedToken(AExpected : TSQLTokens); overload; // All elements must be created with this factory function - Function CreateElement(AElementClass : TSQLElementClass; APArent : TSQLElement) : TSQLElement; virtual; + function CreateElement(AElementClass : TSQLElementClass; APArent : TSQLElement) : TSQLElement; virtual; function CreateLiteral(AParent: TSQLElement): TSQLLiteral; - Function CreateIdentifier(AParent : TSQLElement; Const AName : TSQLStringType) : TSQLIdentifierName; - // Verify that current token is the expect token; raise error if not + function CreateIdentifier(AParent : TSQLElement; Const AName : TSQLStringType) : TSQLIdentifierName; + // Verify that current token is the expected token; raise error if not procedure Expect(aToken: TSQLToken); + // Verify that current token is one of the expected tokens; raise error if not procedure Expect(aTokens: TSQLTokens); - // Expects aToken and eats it + // Expects aToken as current token and eats it procedure Consume(aToken: TSQLToken); procedure Error(Msg : String); - Procedure Error(Fmt : String; Args : Array of const); + procedure Error(Fmt : String; Args : Array of const); // Expression support function ParseExprLevel1(AParent: TSQLElement; EO : TExpressionOptions): TSQLExpression; function ParseExprLevel2(AParent: TSQLElement; EO : TExpressionOptions): TSQLExpression; @@ -195,7 +196,7 @@ Resourcestring 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 typ definition.'; + SErrDomainNotAllowed = 'Domain name not allowed in type definition.'; SErrExpectedChar = 'Expected CHAR or CHARACTER, got "%s"'; SERRVaryingNotAllowed = 'VARYING not allowed at this point.'; SErrUnknownBooleanOp = 'Unknown boolean operation'; @@ -804,7 +805,7 @@ begin Result.ComputedBy:=ParseExprLevel1(Result,[eoComputedBy]); Consume(tsqlBraceClose); end - else + else //not computed, regular field Result.FieldType:=ParseTypeDefinition(Result,[ptfAllowDomainName,ptfAllowConstraint,ptfTableFieldDef]); except FreeAndNil(Result); @@ -1618,8 +1619,13 @@ begin If CurrentToken=tsqlSubtype then // SUB_TYPE T begin GetNextToken; - Expect(tsqlIntegerNumber); - ABlobType:=StrtoInt(CurrentTokenString); + Expect([tsqlIntegerNumber,tsqlBinary,tsqlText]); + case CurrentToken of + tsqlBinary: ABlobType:=0; //FB2.0+ see Language Reference Update + tsqlText: ABlobType:=1; + tsqlIntegerNumber: ABlobType:=StrtoInt(CurrentTokenString); + else Error('ParseBlobDefinition: internal error: unknown token type.'); + end; GetNextToken; end; If (CurrentToken=tsqlSegment) then // SEGMENT SIZE S @@ -1837,6 +1843,12 @@ begin dt:=sdtDate; tsqlTimeStamp: dt:=sdtDateTime; + tsqlDouble: + begin + GetNextToken; + Consume(tsqlPrecision); //DOUBLE PRECISION + dt:=sdtDoublePrecision; + end; tsqlFloat: dt:=sdtFloat; tsqlTime: diff --git a/packages/fcl-db/src/sql/fpsqlscanner.pp b/packages/fcl-db/src/sql/fpsqlscanner.pp index 223b8863e3..77001366c0 100644 --- a/packages/fcl-db/src/sql/fpsqlscanner.pp +++ b/packages/fcl-db/src/sql/fpsqlscanner.pp @@ -42,11 +42,12 @@ type tsqlPlaceHolder,tsqlCOMMA,tsqlCOLON,tsqlDOT,tsqlSEMICOLON,tsqlGT,tsqlLT, tsqlPLUS,tsqlMINUS,tsqlMUL,tsqlDIV,tsqlConcatenate, tsqlEQ,tsqlGE,tsqlLE,tsqlNE, - { Reserved words start here. They must be last } + { Reserved words/keywords start here. They must be last } + { Note: if adding before tsqlALL or after tsqlWHEN please update FirstKeyword/LastKeyword } tsqlALL, tsqlAND, tsqlANY, tsqlASC, tsqlASCENDING, tsqlAVG, tsqlALTER, tsqlAdd, tsqlActive, tsqlAction, tsqlAs,tsqlAt, tsqlAuto,tsqlAfter,tsqlAdmin, - tsqlBETWEEN, tsqlBY, tsqlBLOB,tsqlBegin, tsqlBefore, + tsqlBETWEEN, tsqlBinary, tsqlBY, tsqlBLOB, tsqlBegin, tsqlBefore, tsqlCOLLATE, tsqlCONTAINING, tsqlCOUNT, tsqlCREATE, tsqlCOLUMN, tsqlCONSTRAINT, tsqlChar,tsqlCHARACTER, tsqlCHECK, tsqlComputed,tsqlCASCADE, tsqlCast, tsqlCommit,tsqlConnect,tsqlCache,tsqlConditional,tsqlCString, - tsqlDESC, tsqlDESCENDING, tsqlDISTINCT, tsqlDEFAULT, tsqlDELETE, tsqlDO, tsqlDECLARE, tsqlDROP, tsqlDomain, tsqlDecimal, tsqlDate,tsqlDatabase, + tsqlDESC, tsqlDESCENDING, tsqlDISTINCT, tsqlDEFAULT, tsqlDELETE, tsqlDO, tsqlDouble, tsqlDECLARE, tsqlDROP, tsqlDomain, tsqlDecimal, tsqlDate,tsqlDatabase, tsqlESCAPE, tsqlEXISTS, tsqlELSE, tsqlException, tsqlExternal, tsqlExecute, tsqlEnd,tsqlExit,tsqlEntrypoint,tsqlExtract, tsqlFROM, tsqlFULL, tsqlFOREIGN, tsqlFOR, tsqlFUNCTION, tsqlFLOAT, tsqlFile,tsqlFreeIt, tsqlGenerator, tsqlGROUP, tsqlGenID,tsqlGDSCODE,tsqlGrant, @@ -58,10 +59,10 @@ type tsqlMAX, tsqlMIN, tsqlMERGE, tsqlManual, tsqlModuleName, tsqlNOT, tsqlNULL, tsqlNUMERIC , tsqlNChar, tsqlNATIONAL,tsqlNO, tsqlNatural, tsqlON, tsqlOR, tsqlORDER, tsqlOUTER, tsqlOption, - tsqlPRIMARY, tsqlProcedure, tsqlPosition, tsqlPlan, tsqlPassword, tsqlPage,tsqlPages,tsqlPageSize,tsqlPostEvent,tsqlPrivileges,tsqlPublic, + tsqlPrecision, tsqlPRIMARY, tsqlProcedure, tsqlPosition, tsqlPlan, tsqlPassword, tsqlPage,tsqlPages,tsqlPageSize,tsqlPostEvent,tsqlPrivileges,tsqlPublic, tsqlRIGHT, tsqlROLE, tsqlReferences, tsqlRollBack, tsqlRelease, tsqlretain, tsqlReturningValues,tsqlReturns, tsqlrevoke, tsqlSELECT, tsqlSET, tsqlSINGULAR, tsqlSOME, tsqlSTARTING, tsqlSUM, tsqlSKIP,tsqlSUBTYPE,tsqlSize,tsqlSegment, tsqlSORT, tsqlSnapShot,tsqlSchema,tsqlShadow,tsqlSuspend,tsqlSQLCode,tsqlSmallint, - tSQLTABLE, tsqlTrigger,tsqlTime,tsqlTimeStamp,tsqlType, tsqlTo, tsqlTransaction,tsqlThen, + 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 @@ -83,11 +84,11 @@ const '?',',',':','.',';','>','<', '+','-','*','/','||', '=','>=','<=','<>', - // Identifiers last + // Identifiers last: 'ALL', 'AND', 'ANY', 'ASC', 'ASCENDING', 'AVG', 'ALTER', 'ADD','ACTIVE','ACTION', 'AS', 'AT', 'AUTO', 'AFTER', 'ADMIN', - 'BETWEEN', 'BY', 'BLOB','BEGIN', 'BEFORE', + 'BETWEEN', 'BINARY', 'BY', 'BLOB','BEGIN', 'BEFORE', 'COLLATE', 'CONTAINING', 'COUNT', 'CREATE', 'COLUMN', 'CONSTRAINT', 'CHAR','CHARACTER','CHECK', 'COMPUTED','CASCADE','CAST', 'COMMIT', 'CONNECT', 'CACHE','CONDITIONAL', 'CSTRING', - 'DESC', 'DESCENDING', 'DISTINCT', 'DEFAULT', 'DELETE', 'DO', 'DECLARE', 'DROP', 'DOMAIN', 'DECIMAL', 'DATE','DATABASE', + 'DESC', 'DESCENDING', 'DISTINCT', 'DEFAULT', 'DELETE', 'DO', 'DOUBLE', 'DECLARE', 'DROP', 'DOMAIN', 'DECIMAL', 'DATE','DATABASE', 'ESCAPE', 'EXISTS', 'ELSE', 'EXCEPTION', 'EXTERNAL','EXECUTE', 'END','EXIT','ENTRY_POINT','EXTRACT', 'FROM', 'FULL','FOREIGN', 'FOR', 'FUNCTION', 'FLOAT','FILE', 'FREE_IT', 'GENERATOR', 'GROUP', 'GEN_ID','GDSCODE','GRANT', @@ -99,10 +100,10 @@ const 'MAX', 'MIN', 'MERGE', 'MANUAL', 'MODULE_NAME', 'NOT', 'NULL', 'NUMERIC','NCHAR','NATIONAL', 'NO', 'NATURAL', 'ON', 'OR', 'ORDER', 'OUTER', 'OPTION', - 'PRIMARY', 'PROCEDURE','POSITION','PLAN', 'PASSWORD','PAGE','PAGES','PAGE_SIZE','POST_EVENT','PRIVILEGES','PUBLIC', + 'PRECISION', 'PRIMARY', 'PROCEDURE','POSITION','PLAN', 'PASSWORD','PAGE','PAGES','PAGE_SIZE','POST_EVENT','PRIVILEGES','PUBLIC', 'RIGHT', 'ROLE', 'REFERENCES', 'ROLLBACK','RELEASE', 'RETAIN', 'RETURNING_VALUES', 'RETURNS','REVOKE', 'SELECT', 'SET', 'SINGULAR', 'SOME', 'STARTING', 'SUM', 'SKIP','SUB_TYPE', 'SIZE', 'SEGMENT', 'SORT', 'SNAPSHOT','SCHEMA','SHADOW','SUSPEND','SQLCODE','SMALLINT', - 'TABLE','TRIGGER', 'TIME','TIMESTAMP', 'TYPE', 'TO', 'TRANSACTION','THEN', + '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' @@ -637,7 +638,7 @@ begin BuildKeyWords; P:=FKeyWords.Find(S); If (P<>Nil) then - Result:=P^; + Result:=P^; //keyword found { I:=FirstKeyword; While (Result=tsqlIdentifier) and (I<=Lastkeyword) do begin diff --git a/packages/fcl-db/tests/tcparser.pas b/packages/fcl-db/tests/tcparser.pas index 464accfc2d..12633c6483 100644 --- a/packages/fcl-db/tests/tcparser.pas +++ b/packages/fcl-db/tests/tcparser.pas @@ -166,6 +166,8 @@ type procedure TestBlob4; procedure TestBlob5; procedure TestBlob6; + procedure TestBlob7; + procedure TestBlob8; procedure TestBlobError1; procedure TestBlobError2; procedure TestBlobError3; @@ -175,6 +177,7 @@ type procedure TestBlobError7; procedure TestSmallInt; procedure TestFloat; + procedure TestDoublePrecision; end; { TTestCheckParser } @@ -1746,6 +1749,29 @@ begin AssertEquals('Blob segment size',0,TD.Len); AssertEquals('Character set','',TD.Charset); end; + +procedure TTestTypeParser.TestBlob7; +var + TD : TSQLTypeDefinition; + +begin + TD:=TestType('BLOB SUB_TYPE BINARY',[],sdtBlob); + AssertEquals('Blob type 0',0,TD.BlobType); + AssertEquals('Blob segment size',0,TD.Len); + AssertEquals('Character set','',TD.Charset); +end; + +procedure TTestTypeParser.TestBlob8; +var + TD : TSQLTypeDefinition; + +begin + TD:=TestType('BLOB SUB_TYPE TEXT',[],sdtBlob); + AssertEquals('Blob type 1',1,TD.BlobType); + AssertEquals('Blob segment size',0,TD.Len); + AssertEquals('Character set','',TD.Charset); +end; + procedure TTestTypeParser.TestSmallInt; Var @@ -1761,6 +1787,13 @@ begin TD:=TestType('FLOAT',[],sdtFloat); end; +procedure TTestTypeParser.TestDoublePrecision; +var + TD : TSQLTypeDefinition; +begin + TD:=TestType('DOUBLE PRECISION',[],sdtDoublePrecision); +end; + procedure TTestTypeParser.TestBlobError1; begin FerrSource:='BLOB (1,)'; diff --git a/packages/fcl-db/tests/tcsqlscanner.pas b/packages/fcl-db/tests/tcsqlscanner.pas index 5441c947aa..f4ef0e8542 100644 --- a/packages/fcl-db/tests/tcsqlscanner.pas +++ b/packages/fcl-db/tests/tcsqlscanner.pas @@ -1,6 +1,6 @@ { This file is part of the Free Component Library - Copyright (c) 2010 by the Free Pascal development team + Copyright (c) 2010-2014 by the Free Pascal development team SQL source lexical scanner test suite @@ -291,7 +291,7 @@ Var begin CreateScanner(ASource); J:=Scanner.FetchToken; - EN2:=GetEnumName(TypeINfo(TSQLToken),Ord(AToken)); + EN2:=GetEnumName(TypeInfo(TSQLToken),Ord(AToken)); AssertEquals(Format('Source %s should result in %s.',[ASource,EN2]),AToken,J); end;