mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-19 13:29:29 +02:00
* fcl-db: sql parser: Allow:
- double precision datatype - blob subtype text and blob subtype binary (instead of only blob subtype 0 and 1) - Associated tests git-svn-id: trunk@27887 -
This commit is contained in:
reiniero
parent
9898474fa7
commit
e1d9a068c0
@ -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:
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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,)';
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user