fcl-css: started skipping invalid selectors

packages/fcl-css/src/fpcssparser.pp

@@ -43,8 +43,10 @@ Type
     Function GetCurLine : Integer;
     Function GetCurPos : Integer;
   protected
-    Procedure DoError(Msg : TCSSString);
-    Procedure DoError(Fmt : TCSSString; const Args : Array of const);
+    Procedure DoWarn(const Msg : TCSSString);
+    Procedure DoWarn(const Fmt : TCSSString; const Args : Array of const);
+    Procedure DoError(const Msg : TCSSString);
+    Procedure DoError(const Fmt : TCSSString; const Args : Array of const);
     Procedure Consume(aToken : TCSSToken);
     Procedure SkipWhiteSpace;
     function ParseComponentValueList(AllowRules: Boolean=True): TCSSElement;
@@ -74,6 +76,7 @@ Type
     Function ParseUnicodeRange : TCSSElement;
     function ParseArray(aPrefix: TCSSElement): TCSSElement;
     function ParseURL: TCSSElement;
+    function ParseInvalidToken: TCSSElement;
     Property CurrentSource : TCSSString Read GetCurSource;
     Property CurrentLine : Integer Read GetCurLine;
     Property CurrentPos : Integer Read GetCurPos;
@@ -155,22 +158,22 @@ begin
   Result:=(CurrentToken=ctkEOF);
 end;
 
-procedure TCSSParser.DoError(Msg: TCSSString);
+procedure TCSSParser.DoError(const Msg: TCSSString);
 Var
   ErrAt : TCSSString;
 
 begin
   If Assigned(FScanner) then
     If FScanner.CurFilename<>'' then
-      ErrAt:=Format(SErrFileSource,[FScanner.CurFileName,FScanner.CurRow,FScanner.CurColumn])
+      ErrAt:=SafeFormat(SErrFileSource,[FScanner.CurFileName,FScanner.CurRow,FScanner.CurColumn])
     else
-      ErrAt:=Format(SErrSource,[FScanner.Currow,FScanner.CurColumn]);
+      ErrAt:=SafeFormat(SErrSource,[FScanner.Currow,FScanner.CurColumn]);
   Raise ECSSParser.Create(ErrAt+Msg)
 end;
 
-procedure TCSSParser.DoError(Fmt: TCSSString; const Args: array of const);
+procedure TCSSParser.DoError(const Fmt: TCSSString; const Args: array of const);
 begin
-  DoError(Format(Fmt,Args));
+  DoError(SafeFormat(Fmt,Args));
 end;
 
 procedure TCSSParser.Consume(aToken: TCSSToken);
@@ -214,6 +217,19 @@ begin
     Result:=0;
 end;
 
+procedure TCSSParser.DoWarn(const Msg: TCSSString);
+begin
+  if Assigned(Scanner.OnWarn) then
+    Scanner.OnWarn(Self,Msg)
+  else
+    DoError(Msg);
+end;
+
+procedure TCSSParser.DoWarn(const Fmt: TCSSString; const Args: array of const);
+begin
+  DoWarn(SafeFormat(Fmt,Args));
+end;
+
 constructor TCSSParser.Create(AInput: TStream; ExtraScannerOptions : TCSSScannerOptions = []);
 begin
   FInput:=AInput;
@@ -723,6 +739,12 @@ begin
   end;
 end;
 
+function TCSSParser.ParseInvalidToken: TCSSElement;
+begin
+  Result:=TCSSElement(CreateElement(TCSSElement));
+  GetNextToken;
+end;
+
 function TCSSParser.ParsePseudo: TCSSElement;
 
 Var
@@ -987,11 +1009,16 @@ function TCSSParser.ParseSelector: TCSSElement;
       ctkPSEUDO: Result:=ParsePseudo;
       ctkPSEUDOFUNCTION: Result:=ParseCall('');
     else
-      DoError(SErrUnexpectedToken ,[
+      DoWarn(SErrUnexpectedToken ,[
                GetEnumName(TypeInfo(TCSSToken),Ord(CurrentToken)),
                CurrentTokenString,
                'selector'
                ]);
+      case CurrentToken of
+      ctkINTEGER: Result:=ParseInteger;
+      ctkFLOAT: Result:=ParseFloat;
+      else Result:=ParseInvalidToken;
+      end;
     end;
   end;
 
@@ -1011,11 +1038,11 @@ begin
   Scanner.ReturnWhiteSpace:=true;
   try
     repeat
-      //writeln('TCSSParser.ParseSelector LIST START ',CurrentToken);
+      //writeln('TCSSParser.ParseSelector LIST START ',CurrentToken,' ',CurrentTokenString);
       // read list
       List:=nil;
       El:=ParseSub;
-      //writeln('TCSSParser.ParseSelector LIST NEXT ',CurrentToken);
+      //writeln('TCSSParser.ParseSelector LIST NEXT ',CurrentToken,' ',CurrentTokenString);
       while CurrentToken in [ctkSTAR,ctkIDENTIFIER,ctkCLASSNAME,ctkLBRACKET,ctkPSEUDO,ctkPSEUDOFUNCTION] do
         begin
         if List=nil then
@@ -1035,7 +1062,7 @@ begin
         Result:=El;
       El:=nil;
 
-      //writeln('TCSSParser.ParseSelector LIST END ',CurrentToken);
+      //writeln('TCSSParser.ParseSelector LIST END ',CurrentToken,' ',CurrentTokenString);
       SkipWhiteSpace;
 
       case CurrentToken of

packages/fcl-css/src/fpcssscanner.pp

@@ -124,10 +124,12 @@ Type
 
   TCSSScannerOption = (csoExtendedIdentifiers,csoReturnComments,csoReturnWhiteSpace);
   TCSSScannerOptions = set of TCSSScannerOption;
+  TCSSScannerWarnEvent = procedure(Sender: TObject; Msg: string) of object;
 
   TCSSScanner = class
   private
     FDisablePseudo: Boolean;
+    FOnWarn: TCSSScannerWarnEvent;
     FOptions: TCSSScannerOptions;
     FSourceFile: TLineReader;
     FSourceFilename: TCSSString;
@@ -176,9 +178,11 @@ Type
     property CurColumn: Integer read GetCurColumn;
     property CurToken: TCSSToken read FCurToken;
     property CurTokenString: TCSSString read FCurTokenString;
-    Property DisablePseudo : Boolean Read FDisablePseudo Write FDisablePseudo;
+    property DisablePseudo : Boolean Read FDisablePseudo Write FDisablePseudo;
+    property OnWarn: TCSSScannerWarnEvent read FOnWarn write FOnWarn;
   end;
 
+function SafeFormat(const Fmt: string; const Args: array of const): string;
 
 implementation
 
@@ -190,6 +194,82 @@ Const
   WhiteSpace = [' ',#9];
   WhiteSpaceEx = WhiteSpace+[#0];
 
+type
+  TMessageArgs = array of string;
+
+procedure CreateMsgArgs(var MsgArgs: TMessageArgs; const Args: array of const);
+var
+  i: Integer;
+  {$ifdef pas2js}
+  v: jsvalue;
+  {$endif}
+begin
+  SetLength(MsgArgs, High(Args)-Low(Args)+1);
+  for i:=Low(Args) to High(Args) do
+    {$ifdef pas2js}
+    begin
+    v:=Args[i];
+    if isBoolean(v) then
+      MsgArgs[i] := BoolToStr(Boolean(v))
+    else if isString(v) then
+      MsgArgs[i] := String(v)
+    else if isNumber(v) then
+      begin
+      if IsInteger(v) then
+        MsgArgs[i] := str(NativeInt(v))
+      else
+        MsgArgs[i] := str(double(v));
+      end
+    else
+      MsgArgs[i]:='';
+    end;
+    {$else}
+    case Args[i].VType of
+      vtInteger:      MsgArgs[i] := IntToStr(Args[i].VInteger);
+      vtBoolean:      MsgArgs[i] := BoolToStr(Args[i].VBoolean);
+      vtChar:         MsgArgs[i] := Args[i].VChar;
+      {$ifndef FPUNONE}
+      vtExtended:     ; //  Args[i].VExtended^;
+      {$ENDIF}
+      vtString:       MsgArgs[i] := Args[i].VString^;
+      vtPointer:      ; //  Args[i].VPointer;
+      vtPChar:        MsgArgs[i] := Args[i].VPChar;
+      vtObject:       ; //  Args[i].VObject;
+      vtClass:        ; //  Args[i].VClass;
+      vtWideChar:     MsgArgs[i] := AnsiString(Args[i].VWideChar);
+      vtPWideChar:    MsgArgs[i] := Args[i].VPWideChar;
+      vtAnsiString:   MsgArgs[i] := AnsiString(Args[i].VAnsiString);
+      vtCurrency:     ; //  Args[i].VCurrency^);
+      vtVariant:      ; //  Args[i].VVariant^);
+      vtInterface:    ; //  Args[i].VInterface^);
+      vtWidestring:   MsgArgs[i] := AnsiString(WideString(Args[i].VWideString));
+      vtInt64:        MsgArgs[i] := IntToStr(Args[i].VInt64^);
+      vtQWord:        MsgArgs[i] := IntToStr(Args[i].VQWord^);
+      vtUnicodeString:MsgArgs[i] := AnsiString(UnicodeString(Args[i].VUnicodeString));
+    end;
+    {$endif}
+end;
+
+function SafeFormat(const Fmt: string; const Args: array of const): string;
+var
+  MsgArgs: TMessageArgs;
+  i: Integer;
+begin
+  try
+    Result:=Format(Fmt,Args);
+  except
+    Result:='';
+    MsgArgs:=nil;
+    CreateMsgArgs(MsgArgs,Args);
+    for i:=0 to length(MsgArgs)-1 do
+      begin
+      if i>0 then
+        Result:=Result+',';
+      Result:=Result+MsgArgs[i];
+      end;
+    Result:='{'+Fmt+'}['+Result+']';
+  end;
+end;
 
 constructor TFileLineReader.Create(const AFilename: TCSSString);
 begin

packages/fcl-css/tests/tccssparser.pp

@@ -19,7 +19,8 @@ unit tcCSSParser;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testregistry, fpcssparser, fpcsstree;
+  Classes, SysUtils, fpcunit, testregistry, fpcssparser, fpcsstree,
+  fpCSSScanner;
 
 type
 
@@ -28,11 +29,13 @@ type
   TTestBaseCSSParser = class(TTestCase)
   Private
     FParseResult: TCSSElement;
+    FSkipInvalid: boolean;
     FSource : TStringStream;
     FParser : TCSSParser;
     FToFree: TCSSElement;
     procedure Clear;
     function GetRule: TCSSRuleElement;
+    procedure OnScannerWarn(Sender: TObject; Msg: string);
   protected
     procedure SetUp; override;
     procedure TearDown; override;
@@ -57,6 +60,7 @@ type
     Property ParseResult : TCSSElement read FParseResult;
     Property FirstRule : TCSSRuleElement Read GetRule;
     Property ToFree : TCSSElement Read FToFree Write FToFree;
+    Property SkipInvalid: boolean read FSkipInvalid write FSkipInvalid;
   end;
 
   { TTestCSSParser }
@@ -190,7 +194,6 @@ begin
     end;
 end;
 
-
 procedure TTestCSSFilesParser.Testabsolute;
 begin
   RunFileTest;
@@ -747,11 +750,13 @@ end;
 
 procedure TTestCSSParser.TestOneDeclarationNoColon;
 begin
+  SkipInvalid:=true;
   ParseRule('@a b { 0% { d: e; } }');
 end;
 
 procedure TTestCSSParser.TestTwoDeclarationNoColon;
 begin
+  SkipInvalid:=true;
   ParseRule('@a b { 0% { d: e; } 100% { f : g; }  }');
 end;
 
@@ -808,6 +813,14 @@ begin
     Result:=TCSSRuleElement(CheckClass('First element is rule',TCSSRuleElement,L.Children[0]));
 end;
 
+procedure TTestBaseCSSParser.OnScannerWarn(Sender: TObject; Msg: string);
+var
+  aScanner: TCSSScanner;
+begin
+  aScanner:=FParser.Scanner;
+  writeln('TTestBaseCSSParser.OnScannerWarn ',aScanner.CurFilename+'('+IntToStr(aScanner.CurRow)+','+IntToStr(aScanner.CurColumn)+') ',Msg);
+end;
+
 procedure TTestBaseCSSParser.SetUp;
 begin
   inherited SetUp;
@@ -836,6 +849,8 @@ begin
   Clear;
   FSource:=TStringStream.Create(ASource);
   FParser:=TCSSParser.Create(FSource);
+  if SkipInvalid then
+    FParser.Scanner.OnWarn:=@OnScannerWarn;
 end;
 
 procedure TTestBaseCSSParser.Parse;