* Fixes Sql parsing problems with spaces lacking between keyword and expression

	(like where(id=0) ) Mantis #21965, patch by Ludo, updated by Lacak2.

git-svn-id: trunk@21742 -

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

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;