Browse Source

--- Merging r21682 into '.':
U packages/fcl-db/src/base/dsparams.inc
--- Merging r21683 into '.':
U packages/fcl-db/tests/testdbbasics.pas
--- Merging r21742 into '.':
U packages/fcl-db/tests/testfieldtypes.pas
U packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r21743 into '.':
U packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r21750 into '.':
U packages/fcl-db/src/sqldb/postgres/pqconnection.pp

# revisions: 21682,21683,21742,21743,21750
r21682 | marco | 2012-06-22 21:14:26 +0200 (Fri, 22 Jun 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/dsparams.inc

* skip newline after comment. Patch by Lacak2, #22031
r21683 | marco | 2012-06-22 21:16:42 +0200 (Fri, 22 Jun 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/tests/testdbbasics.pas

* fix misnamed field in lookup related test, mantis #22113, patch by Lacak2.
r21742 | marco | 2012-06-30 19:53:42 +0200 (Sat, 30 Jun 2012) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

* Fixes Sql parsing problems with spaces lacking between keyword and expression
(like where(id=0) ) Mantis #21965, patch by Ludo, updated by Lacak2.
r21743 | marco | 2012-06-30 19:57:29 +0200 (Sat, 30 Jun 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

* Mantis #22249 Mysql BIT type support.
r21750 | marco | 2012-07-01 17:50:13 +0200 (Sun, 01 Jul 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

* Improved pqconnection error reporting. Patch by Ludo, Mantis #22336

git-svn-id: branches/fixes_2_6@22440 -

marco 13 years ago
parent
commit
a1df3c658e

+ 2 - 1
packages/fcl-db/src/base/dsparams.inc

@@ -213,7 +213,8 @@ begin
           repeat // skip until at end of line
             Inc(p);
           until p^ in [#10, #0];
-        end
+        end;
+        if p^<>#0 then Inc(p); // newline is part of comment
       end;
     '/': // possible start of /* */ comment
       begin

+ 18 - 15
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -530,9 +530,9 @@ begin
   C:=Cursor as TCursorName;
   if c.FStatementType in [stSelect,stExecProcedure] then
     c.FNeedData:=False;
-  If (C.FRes<>Nil) then
+  if assigned(C.FRes) then
     begin
-    Mysql_free_result(C.FRes);
+    mysql_free_result(C.FRes);
     C.FRes:=Nil;
     end;
   SetLength(c.MapDSRowToMSQLRow,0);
@@ -588,16 +588,15 @@ var ASize, ADecimals: integer;
 begin
   Result := True;
   ASize := AField^.length;
+  NewSize := 0;
   case AField^.ftype of
     FIELD_TYPE_LONGLONG:
       begin
       NewType := ftLargeint;
-      NewSize := 0;
       end;
     FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_YEAR:
       begin
       NewType := ftSmallint;
-      NewSize := 0;
       end;
     FIELD_TYPE_LONG, FIELD_TYPE_INT24:
       begin
@@ -605,7 +604,6 @@ begin
         NewType := ftAutoInc
       else
         NewType := ftInteger;
-      NewSize := 0;
       end;
 {$ifdef mysql50_up}
     FIELD_TYPE_NEWDECIMAL,
@@ -624,32 +622,25 @@ begin
     FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
       begin
       NewType := ftFloat;
-      NewSize := 0;
       end;
     FIELD_TYPE_TIMESTAMP, FIELD_TYPE_DATETIME:
       begin
       NewType := ftDateTime;
-      NewSize := 0;
       end;
     FIELD_TYPE_DATE:
       begin
       NewType := ftDate;
-      NewSize := 0;
       end;
     FIELD_TYPE_TIME:
       begin
       NewType := ftTime;
-      NewSize := 0;
       end;
     FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
       begin
       // Since mysql server version 5.0.3 string-fields with a length of more
       // then 256 characters are suported
       if ASize>dsMaxStringSize then
-        begin
-        NewType := ftMemo;
-        NewSize := 0;
-        end
+        NewType := ftMemo
       else
         begin
         if AField^.ftype = FIELD_TYPE_STRING then
@@ -676,8 +667,11 @@ begin
 {$ELSE}
       NewType := ftBlob;
 {$ENDIF}
-      NewSize := 0;
-      end
+      end;
+{$IFDEF MYSQL50_UP}
+    FIELD_TYPE_BIT:
+      NewType := ftLargeInt;
+{$ENDIF}
   else
     Result := False;
   end;
@@ -1028,6 +1022,15 @@ begin
       end;
     FIELD_TYPE_BLOB:
       CreateBlob := True;
+{$IFDEF MYSQL50_UP}
+    FIELD_TYPE_BIT:
+      begin
+      VL := 0;
+      for VI := 0 to Len-1 do
+        VL := VL * 256 + PByte(Source+VI)^;
+      move(VL, Dest^, sizeof(LargeInt));
+      end;
+{$ENDIF}
   end;
   Result := True;
 end;

+ 89 - 93
packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -39,6 +39,7 @@ type
     FConnectString       : string;
     FSQLDatabaseHandle   : pointer;
     FIntegerDateTimes    : boolean;
+    procedure CheckResultError(res: PPGresult; conn:PPGconn; ErrMsg: string);
     function TranslateFldType(res : PPGresult; Tuple : integer; out Size : integer) : TFieldType;
     procedure ExecuteDirectPG(const Query : String);
   protected
@@ -86,6 +87,15 @@ type
     Class Function Description : String; override;
   end;
 
+  EPQDatabaseError = class(EDatabaseError)
+    public
+      SEVERITY:string;
+      SQLSTATE: string;
+      MESSAGE_PRIMARY:string;
+      MESSAGE_DETAIL:string;
+      MESSAGE_HINT:string;
+      STATEMENT_POSITION:string;
+  end;
 
 implementation
 
@@ -179,18 +189,10 @@ begin
 
   res := PQexec(ASQLDatabaseHandle,pchar(query));
 
-  if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
-    begin
-    msg := PQerrorMessage(ASQLDatabaseHandle);
-    PQclear(res);
-    PQFinish(ASQLDatabaseHandle);
-    DatabaseError(SDBCreateDropFailed + ' (PostgreSQL: ' + Msg + ')',self);
-    end
-  else
-    begin
-    PQclear(res);
-    PQFinish(ASQLDatabaseHandle);
-    end;
+  CheckResultError(res,ASQLDatabaseHandle,SDBCreateDropFailed);
+
+  PQclear(res);
+  PQFinish(ASQLDatabaseHandle);
 {$IfDef LinkDynamically}
   ReleasePostgres3;
 {$EndIf}
@@ -212,18 +214,12 @@ begin
   tr := trans as TPQTrans;
 
   res := PQexec(tr.PGConn, 'ROLLBACK');
-  if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
-    begin
-    PQclear(res);
-    result := false;
-    DatabaseError(SErrRollbackFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self);
-    end
-  else
-    begin
-    PQclear(res);
-    PQFinish(tr.PGConn);
-    result := true;
-    end;
+
+  CheckResultError(res,tr.PGConn,SErrRollbackFailed);
+
+  PQclear(res);
+  PQFinish(tr.PGConn);
+  result := true;
 end;
 
 function TPQConnection.Commit(trans : TSQLHandle) : boolean;
@@ -236,18 +232,11 @@ begin
   tr := trans as TPQTrans;
 
   res := PQexec(tr.PGConn, 'COMMIT');
-  if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
-    begin
-    PQclear(res);
-    result := false;
-    DatabaseError(SErrCommitFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self);
-    end
-  else
-    begin
-    PQclear(res);
-    PQFinish(tr.PGConn);
-    result := true;
-    end;
+  CheckResultError(res,tr.PGConn,SErrCommitFailed);
+
+  PQclear(res);
+  PQFinish(tr.PGConn);
+  result := true;
 end;
 
 function TPQConnection.StartdbTransaction(trans : TSQLHandle; AParams : string) : boolean;
@@ -272,19 +261,10 @@ begin
     begin
     tr.ErrorOccured := False;
     res := PQexec(tr.PGConn, 'BEGIN');
-    if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
-      begin
-      result := false;
-      PQclear(res);
-      msg := PQerrorMessage(tr.PGConn);
-      PQFinish(tr.PGConn);
-      DatabaseError(sErrTransactionFailed + ' (PostgreSQL: ' + msg + ')',self);
-      end
-    else
-      begin
-      PQclear(res);
-      result := true;
-      end;
+    CheckResultError(res,tr.PGConn,sErrTransactionFailed);
+
+    PQclear(res);
+    result := true;
     end;
 end;
 
@@ -296,25 +276,13 @@ var
 begin
   tr := trans as TPQTrans;
   res := PQexec(tr.PGConn, 'ROLLBACK');
-  if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
-    begin
-    PQclear(res);
-    DatabaseError(SErrRollbackFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self);
-    end
-  else
-    begin
-    PQclear(res);
-    res := PQexec(tr.PGConn, 'BEGIN');
-    if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
-      begin
-      PQclear(res);
-      msg := PQerrorMessage(tr.PGConn);
-      PQFinish(tr.PGConn);
-      DatabaseError(sErrTransactionFailed + ' (PostgreSQL: ' + msg + ')',self);
-      end
-    else
-      PQclear(res);
-    end;
+  CheckResultError(res,tr.PGConn,SErrRollbackFailed);
+
+  PQclear(res);
+  res := PQexec(tr.PGConn, 'BEGIN');
+  CheckResultError(res,tr.PGConn,sErrTransactionFailed);
+
+  PQclear(res);
 end;
 
 procedure TPQConnection.CommitRetaining(trans : TSQLHandle);
@@ -325,25 +293,13 @@ var
 begin
   tr := trans as TPQTrans;
   res := PQexec(tr.PGConn, 'COMMIT');
-  if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
-    begin
-    PQclear(res);
-    DatabaseError(SErrCommitFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self);
-    end
-  else
-    begin
-    PQclear(res);
-    res := PQexec(tr.PGConn, 'BEGIN');
-    if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
-      begin
-      PQclear(res);
-      msg := PQerrorMessage(tr.PGConn);
-      PQFinish(tr.PGConn);
-      DatabaseError(sErrTransactionFailed + ' (PostgreSQL: ' + msg + ')',self);
-      end
-    else
-      PQclear(res);
-    end;
+  CheckResultError(res,tr.PGConn,SErrCommitFailed);
+
+  PQclear(res);
+  res := PQexec(tr.PGConn, 'BEGIN');
+  CheckResultError(res,tr.PGConn,sErrTransactionFailed);
+
+  PQclear(res);
 end;
 
 
@@ -387,6 +343,50 @@ begin
 
 end;
 
+procedure TPQConnection.CheckResultError(res: PPGresult; conn: PPGconn;
+  ErrMsg: string);
+var
+  serr:string;
+  E: EPQDatabaseError;
+  CompName: string;
+  SEVERITY:string;
+  SQLSTATE: string;
+  MESSAGE_PRIMARY:string;
+  MESSAGE_DETAIL:string;
+  MESSAGE_HINT:string;
+  STATEMENT_POSITION:string;
+
+begin
+  if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
+    begin
+    SEVERITY:=PQresultErrorField(res,ord('S'));
+    SQLSTATE:=PQresultErrorField(res,ord('C'));
+    MESSAGE_PRIMARY:=PQresultErrorField(res,ord('M'));
+    MESSAGE_DETAIL:=PQresultErrorField(res,ord('D'));
+    MESSAGE_HINT:=PQresultErrorField(res,ord('H'));
+    STATEMENT_POSITION:=PQresultErrorField(res,ord('P'));
+    serr:=PQresultErrorMessage(res)+LineEnding+
+      'Severity: '+ SEVERITY +LineEnding+
+      'SQL State: '+ SQLSTATE +LineEnding+
+      'Primary Error: '+ MESSAGE_PRIMARY +LineEnding+
+      'Error Detail: '+ MESSAGE_DETAIL +LineEnding+
+      'Hint: '+ MESSAGE_HINT +LineEnding+
+      'Character: '+ STATEMENT_POSITION +LineEnding;
+    pqclear(res);
+    if assigned(conn) then
+      PQFinish(conn);
+    if Self.Name = '' then CompName := Self.ClassName else CompName := Self.Name;
+    E:=EPQDatabaseError.CreateFmt('%s : %s  (PostgreSQL: %s)', [CompName,ErrMsg, serr]);
+    E.SEVERITY:=SEVERITY;
+    E.SQLSTATE:=SQLSTATE;
+    E.MESSAGE_PRIMARY:=MESSAGE_PRIMARY;
+    E.MESSAGE_DETAIL:=MESSAGE_DETAIL;
+    E.MESSAGE_HINT:=MESSAGE_HINT;
+    E.STATEMENT_POSITION:=STATEMENT_POSITION;
+    raise E;
+    end;
+end;
+
 function TPQConnection.TranslateFldType(res : PPGresult; Tuple : integer; out Size : integer) : TFieldType;
 const VARHDRSZ=sizeof(longint);
 var li : longint;
@@ -525,7 +525,7 @@ const TypeStrings : array[TFieldType] of string =
     );
 
 
-var s : string;
+var s,serr : string;
     i : integer;
 
 begin
@@ -559,11 +559,7 @@ begin
         end;
       s := s + ' as ' + buf;
       res := pqexec(tr.PGConn,pchar(s));
-      if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
-        begin
-        pqclear(res);
-        DatabaseError(SErrPrepareFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self)
-        end;
+      CheckResultError(res,nil,SErrPrepareFailed);
       // if statement is INSERT, UPDATE, DELETE with RETURNING clause, then
       // override the statement type derrived by parsing the query.
       if (FStatementType in [stInsert,stUpdate,stDelete]) and (pos('RETURNING', upcase(s)) > 0) then

+ 79 - 81
packages/fcl-db/src/sqldb/sqldb.pp

@@ -1010,7 +1010,7 @@ begin
     end;
 
   if FWhereStartPos = 0 then
-    SQLstr := SQLstr + ' where (' + Filter + ')'
+    SQLstr := SQLstr + ' where (' + ServerFilter + ')'
   else if FWhereStopPos > 0 then
     system.insert(' and ('+ServerFilter+') ',SQLstr,FWhereStopPos+2)
   else
@@ -1217,18 +1217,17 @@ end;
 
 function TCustomSQLQuery.SQLParser(const ASQL : string) : TStatementType;
 
-type TParsePart = (ppStart,ppWith,ppSelect,ppFrom,ppWhere,ppGroup,ppOrder,ppComment,ppBogus);
+type TParsePart = (ppStart,ppWith,ppSelect,ppTableName,ppFrom,ppWhere,ppGroup,ppOrder,ppBogus);
+     TPhraseSeparator = (sepNone, sepWhiteSpace, sepComma, sepComment, sepParentheses, sepEnd);
 
 Var
-  PSQL,CurrentP,
+  PSQL, CurrentP, SavedP,
   PhraseP, PStatementPart : pchar;
   S                       : string;
   ParsePart               : TParsePart;
-  StrLength               : Integer;
-  EndOfComment            : Boolean;
   BracketCount            : Integer;
   ConnOptions             : TConnOptions;
-  FFromPart               : String;
+  Separator               : TPhraseSeparator;
 
 begin
   PSQL:=Pchar(ASQL);
@@ -1237,42 +1236,57 @@ begin
   CurrentP := PSQL-1;
   PhraseP := PSQL;
 
+  FTableName := '';
+  FUpdateable := False;
+
   FWhereStartPos := 0;
   FWhereStopPos := 0;
 
   ConnOptions := TSQLConnection(DataBase).ConnOptions;
-  FUpdateable := False;
 
   repeat
     begin
     inc(CurrentP);
-
-    EndOfComment := SkipComments(CurrentP, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions);
-    if EndOfcomment then dec(CurrentP);
-    if EndOfComment and (ParsePart = ppStart) then PhraseP := CurrentP;
-
-    // skip everything between bracket, since it could be a sub-select, and
-    // further nothing between brackets could be interesting for the parser.
-    if CurrentP^='(' then
-      begin
-      inc(currentp);
-      BracketCount := 0;
-      while (currentp^ <> #0) and ((currentp^ <> ')') or (BracketCount > 0 )) do
+    SavedP := CurrentP;
+
+    case CurrentP^ of
+      ' ', #9, #10, #11, #12, #13:
+        Separator := sepWhiteSpace;
+      ',':
+        Separator := sepComma;
+      #0, ';':
+        Separator := sepEnd;
+      '(':
         begin
-        if currentp^ = '(' then inc(bracketcount)
-        else if currentp^ = ')' then dec(bracketcount);
-        inc(currentp);
+        Separator := sepParentheses;
+        // skip everything between brackets, since it could be a sub-select, and
+        // further nothing between brackets could be interesting for the parser.
+        BracketCount := 1;
+        repeat
+          inc(CurrentP);
+          if CurrentP^ = '(' then inc(BracketCount)
+          else if CurrentP^ = ')' then dec(BracketCount);
+        until (CurrentP^ = #0) or (BracketCount = 0);
+        if CurrentP^ <> #0 then inc(CurrentP);
         end;
-      EndOfComment := True;
-      end;
+      else
+        if SkipComments(CurrentP, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions) then
+          Separator := sepComment
+        else
+          Separator := sepNone;
+    end;
+
+    if (CurrentP > SavedP) and (SavedP > PhraseP) then
+      CurrentP := SavedP;  // there is something before comment or left parenthesis
 
-    if EndOfComment or (CurrentP^ in [' ',#13,#10,#9,#0,';']) then
+    if Separator <> sepNone then
       begin
-      if (CurrentP-PhraseP > 0) or (CurrentP^ in [';',#0]) then
+      if ((Separator in [sepWhitespace,sepComment]) and (PhraseP = SavedP)) then
+        PhraseP := CurrentP;  // skip comments(but not parentheses) and white spaces
+
+      if (CurrentP-PhraseP > 0) or (Separator = sepEnd) then
         begin
-        strLength := CurrentP-PhraseP;
-        Setlength(S,strLength);
-        if strLength > 0 then Move(PhraseP^,S[1],(strLength));
+        SetString(s, PhraseP, CurrentP-PhraseP);
         s := uppercase(s);
 
         case ParsePart of
@@ -1284,7 +1298,6 @@ begin
                        else      break;
                      end;
                      if not FParseSQL then break;
-                     PStatementPart := CurrentP;
                      end;
           ppWith   : begin
                      // WITH [RECURSIVE] CTE_name [ ( column_names ) ] AS ( CTE_query_definition ) [, ...]
@@ -1299,69 +1312,53 @@ begin
                      end;
           ppSelect : begin
                      if s = 'FROM' then
+                       ParsePart := ppTableName;
+                     end;
+          ppTableName:
+                     begin
+                     // Meta-data requests are never updateable
+                     //  and select-statements from more then one table
+                     //  and/or derived tables are also not updateable
+                     if (FSchemaType = stNoSchema) and
+                        (Separator in [sepWhitespace, sepComment, sepEnd]) then
                        begin
-                       ParsePart := ppFrom;
-                       PhraseP := CurrentP;
-                       PStatementPart := CurrentP;
+                       FTableName := s;
+                       FUpdateable := True;
                        end;
+                     ParsePart := ppFrom;
                      end;
           ppFrom   : begin
-                     if (s = 'WHERE') or (s = 'ORDER') or (s = 'GROUP') or (s = 'LIMIT') or (CurrentP^=#0) or (CurrentP^=';') then
+                     if (s = 'WHERE') or (s = 'GROUP') or (s = 'ORDER') or (s = 'LIMIT') or (s = 'ROWS') or
+                        (Separator = sepEnd) then
                        begin
-                       if (s = 'WHERE') then
-                         begin
-                         ParsePart := ppWhere;
-                         StrLength := PhraseP-PStatementPart;
-                         end
-                       else if (s = 'GROUP') then
-                         begin
-                         ParsePart := ppGroup;
-                         StrLength := PhraseP-PStatementPart;
-                         end
-                       else if (s = 'ORDER') then
-                         begin
-                         ParsePart := ppOrder;
-                         StrLength := PhraseP-PStatementPart
-                         end
-                       else if (s = 'LIMIT') then
-                         begin
-                         ParsePart := ppBogus;
-                         StrLength := PhraseP-PStatementPart
-                         end
-                       else
-                         begin
-                         ParsePart := ppBogus;
-                         StrLength := CurrentP-PStatementPart;
-                         end;
-                       if Result = stSelect then
-                         begin
-                         Setlength(FFromPart,StrLength);
-                         Move(PStatementPart^,FFromPart[1],(StrLength));
-                         FFromPart := trim(FFromPart);
-
-                         // Meta-data requests and are never updateable select-statements
-                         // from more then one table are not updateable
-                         if (FSchemaType=stNoSchema) and
-                            (ExtractStrings([',',' '],[],pchar(FFromPart),nil) = 1) then
-                           begin
-                           FUpdateable := True;
-                           FTableName := FFromPart;
-                           end;
-                         end;
-
-                       FWhereStartPos := PStatementPart-PSQL+StrLength+1;
+                       case s of
+                         'WHERE': ParsePart := ppWhere;
+                         'GROUP': ParsePart := ppGroup;
+                         'ORDER': ParsePart := ppOrder;
+                         else     ParsePart := ppBogus;
+                       end;
+
+                       FWhereStartPos := PhraseP-PSQL+1;
                        PStatementPart := CurrentP;
+                       end
+                     else
+                     // joined table or user_defined_function (...)
+                     if (s = 'JOIN') or (Separator in [sepComma, sepParentheses]) then
+                       begin
+                       FTableName := '';
+                       FUpdateable := False;
                        end;
                      end;
           ppWhere  : begin
-                     if (s = 'ORDER') or (s = 'GROUP') or (s = 'LIMIT') or (CurrentP^=#0) or (CurrentP^=';') then
+                     if (s = 'GROUP') or (s = 'ORDER') or (s = 'LIMIT') or (s = 'ROWS') or
+                        (Separator = sepEnd) then
                        begin
                        ParsePart := ppBogus;
                        FWhereStartPos := PStatementPart-PSQL;
-                       if (s = 'ORDER') or (s = 'GROUP') or (s = 'LIMIT') then
-                         FWhereStopPos := PhraseP-PSQL+1
+                       if (Separator = sepEnd) then
+                         FWhereStopPos := CurrentP-PSQL+1
                        else
-                         FWhereStopPos := CurrentP-PSQL+1;
+                         FWhereStopPos := PhraseP-PSQL+1;
                        end
                      else if (s = 'UNION') then
                        begin
@@ -1371,6 +1368,8 @@ begin
                      end;
         end; {case}
         end;
+      if Separator in [sepComment, sepParentheses] then
+        dec(CurrentP);
       PhraseP := CurrentP+1;
       end
     end;
@@ -1381,7 +1380,6 @@ procedure TCustomSQLQuery.InternalOpen;
 
 var tel, fieldc : integer;
     f           : TField;
-    s           : string;
     IndexFields : TStrings;
     ReadFromFile: Boolean;
 begin

+ 7 - 2
packages/fcl-db/tests/testdbbasics.pas

@@ -667,8 +667,13 @@ begin
     CheckFalse(FieldByName('LookupFld').ReadOnly);
 
     CheckEquals(1,FieldByName('ID').AsInteger);
-    CheckEquals('name1',FieldByName('LookupFld').AsString);
-    close;
+    CheckEquals('TestName1',FieldByName('LookupFld').AsString);
+    Next;
+    Next;
+    CheckEquals(3,FieldByName('ID').AsInteger);
+    CheckEquals('TestName3',FieldByName('LookupFld').AsString);
+
+    Close;
     lds.Close;
     end;
 end;

+ 57 - 19
packages/fcl-db/tests/testfieldtypes.pas

@@ -38,7 +38,7 @@ type
     procedure TestInsertLargeStrFields; // bug 9600
     procedure TestNumericNames; // Bug9661
     procedure TestApplyUpdFieldnames; // Bug 12275;
-    procedure TestLimitQuery; // bug 15456
+    procedure TestServerFilter; // bug 15456
     procedure Test11Params;
     procedure TestRowsAffected; // bug 9758
     procedure TestLocateNull;
@@ -1438,7 +1438,13 @@ begin
       begin
       SQL.Text:='select TT.NAME from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID';
       Open;
-      close;
+      AssertFalse(CanModify);
+      Close;
+
+      SQL.Text:='select T1.NAME from FPDEV T1,FPDEV T2 where T1.ID=T2.ID';
+      Open;
+      AssertFalse(CanModify);
+      Close;
       end;
     end;
 end;
@@ -1565,25 +1571,57 @@ begin
     end;
 end;
 
-procedure TTestFieldTypes.TestLimitQuery;
+procedure TTestFieldTypes.TestServerFilter;
 begin
-  with TSQLDBConnector(DBConnector) do
-    begin
-    with query do
-      begin
-      case sqlDBtype of
-        interbase : SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21''';
-        mssql     : SQL.Text:='select top 1 NAME from FPDEV where NAME=''TestName21''';
-        else        SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
-      end;
-      Open;
-      close;
-      ServerFilter:='ID=21';
-      ServerFiltered:=true;
-      open;
-      close;
-      end;
+  // Tests SQLParser and ServerFilter
+  with TSQLDBConnector(DBConnector).Query do
+  begin
+    ServerFilter:='ID=21';
+    ServerFiltered:=true;
+
+    // tests parsing SELECT without WHERE
+    SQL.Text:='select * from FPDEV';
+    Open;
+    CheckTrue(CanModify, SQL.Text);
+    CheckEquals(1, RecordCount);
+    Close;
+
+    SQL.Text:='select *'#13'from FPDEV'#13'order by 1';
+    Open;
+    CheckTrue(CanModify, SQL.Text);
+    CheckEquals(1, RecordCount);
+    Close;
+
+    // tests parsing SELECT with simple WHERE
+    SQL.Text:='select *'#9'from FPDEV'#9'where NAME<>''''';
+    Open;
+    CheckTrue(CanModify, SQL.Text);
+    CheckEquals(1, RecordCount);
+    Close;
+
+    // tests parsing SELECT with simple WHERE followed by ORDER BY
+    SQL.Text:='select *'#10'from FPDEV'#10'where NAME>'''' order by 1';
+    Open;
+    CheckTrue(CanModify, SQL.Text);
+    CheckEquals(1, RecordCount);
+    Close;
+
+    // tests parsing of WHERE ... LIMIT
+    case sqlDBtype of
+      interbase : SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21''';
+      mssql     : SQL.Text:='select top 1 NAME from FPDEV where NAME=''TestName21''';
+      else        SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
     end;
+    Open;
+    CheckTrue(CanModify, SQL.Text);
+    Close;
+
+    // tests parsing SELECT with table alias and embedded comments (MySQL requires space after -- )
+    SQL.Text:='/**/select * from/**/FPDEV as fp-- comment'#13'where(NAME>''TestName20'')/**/order by 1';
+    Open;
+    CheckTrue(CanModify, SQL.Text);
+    Close;
+  end;
 end;
 
 procedure TTestFieldTypes.TestRowsAffected;