Browse Source

* Fix parsing of bootstrap

Michaël Van Canneyt 3 years ago
parent
commit
8b9c7b8254

+ 28 - 20
packages/fcl-css/src/fpcssparser.pp

@@ -14,7 +14,7 @@
  **********************************************************************}
  **********************************************************************}
 unit fpCSSParser;
 unit fpCSSParser;
 
 
-{$mode ObjFPC}{$H+}
+{ $mode ObjFPC}{$H+}
 
 
 { $DEFINE debugparser}
 { $DEFINE debugparser}
 
 
@@ -283,7 +283,7 @@ function TCSSParser.ParseExpression: TCSSElement;
 
 
 Const
 Const
   RuleTokens =
   RuleTokens =
-       [ctkIDENTIFIER,ctkCLASSNAME,ctkHASH,ctkINTEGER,
+       [ctkIDENTIFIER,ctkCLASSNAME,ctkHASH,ctkINTEGER, ctkPSEUDO,ctkPSEUDOFUNCTION,
         ctkDOUBLECOLON,ctkSTAR,ctkTILDE,ctkCOLON,ctkLBRACKET];
         ctkDOUBLECOLON,ctkSTAR,ctkTILDE,ctkCOLON,ctkLBRACKET];
 
 
 begin
 begin
@@ -503,12 +503,12 @@ end;
 function TCSSParser.ParsePseudo: TCSSElement;
 function TCSSParser.ParsePseudo: TCSSElement;
 
 
 Var
 Var
-  aPseudo : TCSSIdentifierElement;
+  aPseudo : TCSSClassNameElement;
   aValue : string;
   aValue : string;
 
 
 begin
 begin
   aValue:=CurrentTokenString;
   aValue:=CurrentTokenString;
-  aPseudo:=TCSSIdentifierElement(CreateElement(TCSSIdentifierElement));
+  aPseudo:=TCSSClassNameElement(CreateElement(TCSSClassNameElement));
   try
   try
     Consume(ctkPseudo);
     Consume(ctkPseudo);
     aPseudo.Value:=aValue;
     aPseudo.Value:=aValue;
@@ -624,7 +624,7 @@ Const
   TermSeps = [ctkEquals,ctkPlus,ctkMinus,ctkAnd,ctkLT,ctkDIV,
   TermSeps = [ctkEquals,ctkPlus,ctkMinus,ctkAnd,ctkLT,ctkDIV,
               ctkStar,ctkTilde,ctkColon, ctkDoubleColon,
               ctkStar,ctkTilde,ctkColon, ctkDoubleColon,
               ctkSquared,ctkGT];
               ctkSquared,ctkGT];
-
+  ListTerms = [ctkEOF,ctkLBRACE,ctkATKEYWORD,ctkComma];
 
 
   function DoBinary(var aLeft : TCSSElement) : TCSSElement;
   function DoBinary(var aLeft : TCSSElement) : TCSSElement;
   var
   var
@@ -644,24 +644,31 @@ Const
     end;
     end;
   end;
   end;
 
 
+Var
+  List : TCSSListElement;
+  aFactor : TCSSelement;
+
 begin
 begin
-  Result:=Nil;
-  if not AllowRules then
-    Result:=ParseComponentValue
-  else
-    Case CurrentToken of
-      ctkLBRACE : Result:=ParseRule();
-      ctkATKEYWORD : Result:=ParseRule(True);
-    else
-      Result:=ParseComponentValue;
-    end;
-  If Not Assigned(Result) then
-    exit;
+  List:=TCSSListElement(CreateElement(TCSSListElement));
   try
   try
-    While CurrentToken in TermSeps do
-      Result:=DoBinary(Result);
+    aFactor:=Nil;
+    if AllowRules and (CurrentToken in [ctkLBRACE,ctkATKEYWORD]) then
+      aFactor:=ParseRule(CurrentToken=ctkATKEYWORD)
+    else
+      aFactor:=ParseComponentValue;
+    While Assigned(aFactor) do
+      begin
+      While CurrentToken in TermSeps do
+        aFactor:=DoBinary(aFactor);
+      List.AddChild(aFactor);
+      if (CurrentToken in ListTerms) then
+        aFactor:=Nil
+      else
+        aFactor:=ParseComponentValue
+      end;
+    Result:=GetAppendElement(List);
   except
   except
-    Result.Free;
+    List.Free;
     Raise;
     Raise;
   end;
   end;
 end;
 end;
@@ -796,6 +803,7 @@ begin
     L:=Length(aName);
     L:=Length(aName);
     if (L>0) and (aName[L]='(') then
     if (L>0) and (aName[L]='(') then
       aName:=Copy(aName,1,L-1);
       aName:=Copy(aName,1,L-1);
+    aCall.Name:=aName;
     if CurrentToken=ctkPSEUDOFUNCTION then
     if CurrentToken=ctkPSEUDOFUNCTION then
       Consume(ctkPSEUDOFUNCTION)
       Consume(ctkPSEUDOFUNCTION)
     else
     else

+ 1 - 1
packages/fcl-css/src/fpcsstree.pp

@@ -235,7 +235,7 @@ Type
   Public
   Public
     Destructor Destroy; override;
     Destructor Destroy; override;
     Procedure AddChild(aChild : TCSSElement); virtual;
     Procedure AddChild(aChild : TCSSElement); virtual;
-    Property Children[aIndex : Integer] : TCSSElement Read GetChild;
+    Property Children[aIndex : Integer] : TCSSElement Read GetChild; default;
     Property ChildCount : Integer Read GetChildCount;
     Property ChildCount : Integer Read GetChildCount;
   end;
   end;
 
 

+ 89 - 17
packages/fcl-css/tests/tccssparser.pp

@@ -47,6 +47,8 @@ type
     Function CheckDeclaration(aRule : TCSSRuleElement; aIndex : Integer; const AKey : String) : TCSSDeclarationElement;
     Function CheckDeclaration(aRule : TCSSRuleElement; aIndex : Integer; const AKey : String) : TCSSDeclarationElement;
     Function CheckSelector(aRule : TCSSRuleElement; aIndex : Integer) : TCSSElement;
     Function CheckSelector(aRule : TCSSRuleElement; aIndex : Integer) : TCSSElement;
     Function CheckSelector(aRule : TCSSRuleElement; aIndex : Integer; const aName : String) : TCSSElement;
     Function CheckSelector(aRule : TCSSRuleElement; aIndex : Integer; const aName : String) : TCSSElement;
+    function CheckList(aList: TCSSListElement; aIndex: Integer): TCSSElement;
+    function CheckList(aList: TCSSListElement; aIndex: Integer; const aName: String): TCSSElement;
     function CheckLiteral(Msg: String; aEl: TCSSelement; aValue: String) : TCSSStringElement; overload;
     function CheckLiteral(Msg: String; aEl: TCSSelement; aValue: String) : TCSSStringElement; overload;
     function CheckLiteral(Msg: String; aEl: TCSSelement; aValue: Integer) : TCSSIntegerElement;  overload;
     function CheckLiteral(Msg: String; aEl: TCSSelement; aValue: Integer) : TCSSIntegerElement;  overload;
     function CheckLiteral(Msg: String; aEl: TCSSelement; aValue: Integer; AUnits : TCSSUnits) : TCSSIntegerElement;  overload;
     function CheckLiteral(Msg: String; aEl: TCSSelement; aValue: Integer; AUnits : TCSSUnits) : TCSSIntegerElement;  overload;
@@ -70,6 +72,8 @@ type
     procedure TestDoublePrefixedEmptyRule;
     procedure TestDoublePrefixedEmptyRule;
     procedure TestDoubleMixedPrefixedEmptyRule;
     procedure TestDoubleMixedPrefixedEmptyRule;
     procedure TestAttributePrefixedEmptyRule;
     procedure TestAttributePrefixedEmptyRule;
+    procedure TestPseudoPrefixedEmptyRule;
+    procedure TestPseudoFunctionEmptyRule;
     procedure TestFuncPrefixedEmptyRule;
     procedure TestFuncPrefixedEmptyRule;
     procedure TestQueryPrefixedEmptyRule;
     procedure TestQueryPrefixedEmptyRule;
     Procedure TestCommaPrefixedEmptyRule;
     Procedure TestCommaPrefixedEmptyRule;
@@ -88,6 +92,7 @@ type
     Procedure TestOneEmptyDeclaration;
     Procedure TestOneEmptyDeclaration;
     Procedure TestImportAtKeyWord;
     Procedure TestImportAtKeyWord;
     Procedure TestMediaPrint;
     Procedure TestMediaPrint;
+    Procedure TestSupportsFunction;
   end;
   end;
 
 
   { TTestCSSFilesParser }
   { TTestCSSFilesParser }
@@ -355,16 +360,19 @@ procedure TTestCSSParser.TestDoublePrefixedEmptyRule;
 var
 var
   R : TCSSRuleElement;
   R : TCSSRuleElement;
   sel: TCSSIdentifierElement;
   sel: TCSSIdentifierElement;
+  List : TCSSListElement;
 
 
 begin
 begin
   ParseRule('a b { }');
   ParseRule('a b { }');
   R:=TCSSRuleElement(CheckClass('Rule',TCSSRuleElement,FirstRule));
   R:=TCSSRuleElement(CheckClass('Rule',TCSSRuleElement,FirstRule));
   AssertEquals('No rule children',0,R.ChildCount);
   AssertEquals('No rule children',0,R.ChildCount);
-  AssertEquals('selector count',2,R.SelectorCount);
-  sel:=TCSSIdentifierElement(CheckClass('Selector', TCSSIdentifierElement,R.Selectors[0]));
-  AssertEquals('Sel name','a',Sel.Value);
-  sel:=TCSSIdentifierElement(CheckClass('Selector', TCSSIdentifierElement,R.Selectors[1]));
-  AssertEquals('Sel name','b',Sel.Value);
+  AssertEquals('selector count',1,R.SelectorCount);
+  List:=TCSSListElement(CheckClass('Selector', TCSSListElement,R.Selectors[0]));
+  AssertEquals('selector list count',2,List.ChildCount);
+  sel:=TCSSIdentifierElement(CheckClass('Selector', TCSSIdentifierElement,List[0]));
+  AssertEquals('Sel 1 name','a',Sel.Value);
+  sel:=TCSSIdentifierElement(CheckClass('Selector', TCSSIdentifierElement,List[1]));
+  AssertEquals('Sel 2 name','b',Sel.Value);
 end;
 end;
 
 
 procedure TTestCSSParser.TestDoubleMixedPrefixedEmptyRule;
 procedure TTestCSSParser.TestDoubleMixedPrefixedEmptyRule;
@@ -372,17 +380,19 @@ procedure TTestCSSParser.TestDoubleMixedPrefixedEmptyRule;
 var
 var
   R : TCSSRuleElement;
   R : TCSSRuleElement;
   sel: TCSSIdentifierElement;
   sel: TCSSIdentifierElement;
-  sel2: TCSSClassNameElement;
+  List : TCSSListElement;
 
 
 begin
 begin
   ParseRule('a .b { }');
   ParseRule('a .b { }');
   R:=TCSSRuleElement(CheckClass('Rule',TCSSRuleElement,FirstRule));
   R:=TCSSRuleElement(CheckClass('Rule',TCSSRuleElement,FirstRule));
   AssertEquals('No rule children',0,R.ChildCount);
   AssertEquals('No rule children',0,R.ChildCount);
-  AssertEquals('selector count',2,R.SelectorCount);
-  sel:=TCSSIdentifierElement(CheckClass('Selector', TCSSIdentifierElement,R.Selectors[0]));
-  AssertEquals('Sel name','a',Sel.Value);
-  sel2:=TCSSClassNameElement(CheckClass('Selector', TCSSClassNameElement,R.Selectors[1]));
-  AssertEquals('Sel name','.b',Sel2.Value);
+  AssertEquals('selector count',1,R.SelectorCount);
+  List:=TCSSListElement(CheckClass('Selector', TCSSListElement,R.Selectors[0]));
+  AssertEquals('selector list count',2,List.ChildCount);
+  sel:=TCSSIdentifierElement(CheckClass('Selector', TCSSIdentifierElement,List[0]));
+  AssertEquals('Sel 1 name','a',Sel.Value);
+  sel:=TCSSClassNameElement(CheckClass('Selector', TCSSClassNameElement,List[1]));
+  AssertEquals('Sel 2 name','.b',Sel.Value);
 end;
 end;
 
 
 procedure TTestCSSParser.TestAttributePrefixedEmptyRule;
 procedure TTestCSSParser.TestAttributePrefixedEmptyRule;
@@ -405,20 +415,53 @@ begin
   AssertEquals('Binary op',boEquals,Bin.Operation);
   AssertEquals('Binary op',boEquals,Bin.Operation);
 end;
 end;
 
 
+procedure TTestCSSParser.TestPseudoPrefixedEmptyRule;
+var
+  R : TCSSRuleElement;
+  Sel : TCSSClassNameElement;
+
+begin
+  ParseRule(':a { }');
+  R:=TCSSRuleElement(CheckClass('Rule',TCSSRuleElement,FirstRule));
+  AssertEquals('No rule children',0,R.ChildCount);
+  AssertEquals('selector count',1,R.SelectorCount);
+  sel:=TCSSClassNameElement(CheckClass('Selector', TCSSClassNameElement,R.Selectors[0]));
+  AssertEquals('Pseudo name',':a',sel.Value);
+end;
+
+procedure TTestCSSParser.TestPseudoFunctionEmptyRule;
+var
+  R : TCSSRuleElement;
+  Sel : TCSSCallElement;
+  Id : TCSSIdentifierElement;
+
+begin
+  ParseRule(':a(b) { }');
+  R:=TCSSRuleElement(CheckClass('Rule',TCSSRuleElement,FirstRule));
+  AssertEquals('No rule children',0,R.ChildCount);
+  AssertEquals('selector count',1,R.SelectorCount);
+  sel:=TCSSCallElement(CheckClass('Selector', TCSSCallElement,R.Selectors[0]));
+  AssertEquals('Pseudo name',':a',sel.Name);
+  AssertEquals('argument count',1,Sel.ChildCount);
+  Id:=TCSSIdentifierElement(CheckClass('Argument 1',TCSSIdentifierElement,Sel[0]));
+  AssertEquals('Argument name','b',id.Name);
+end;
+
 procedure TTestCSSParser.TestFuncPrefixedEmptyRule;
 procedure TTestCSSParser.TestFuncPrefixedEmptyRule;
 
 
 var
 var
   R : TCSSRuleElement;
   R : TCSSRuleElement;
-  sel: TCSSArrayElement;
+  List : TCSSListElement;
 
 
 begin
 begin
   R:=ParseRule('input:enabled:read-write:-webkit-any(:focus,:hover)::-webkit-clear-button {  }');
   R:=ParseRule('input:enabled:read-write:-webkit-any(:focus,:hover)::-webkit-clear-button {  }');
   AssertEquals('No rule children',0,R.ChildCount);
   AssertEquals('No rule children',0,R.ChildCount);
-  AssertEquals('selector count',5,R.SelectorCount);
-  CheckSelector(R,0,'input');
-  CheckSelector(R,1,':enabled');
-  CheckSelector(R,2,':read-write');
-  CheckSelector(R,4,'::-webkit-clear-button');
+  AssertEquals('selector count',1,R.SelectorCount);
+  List:=TCSSListElement(CheckClass('List',TCSSListElement,R.Selectors[0]));
+  CheckList(List,0,'input');
+  CheckList(List,1,':enabled');
+  CheckList(List,2,':read-write');
+  CheckList(List,4,'::-webkit-clear-button');
 end;
 end;
 
 
 procedure TTestCSSParser.TestQueryPrefixedEmptyRule;
 procedure TTestCSSParser.TestQueryPrefixedEmptyRule;
@@ -630,6 +673,19 @@ begin
   ParseRule('@media print { *, *:before {} }');
   ParseRule('@media print { *, *:before {} }');
 end;
 end;
 
 
+procedure TTestCSSParser.TestSupportsFunction;
+begin
+  ParseRule('@supports ((position: -webkit-sticky) or (position: sticky)) {'+ sLineBreak+
+'  .sticky-top { '+ sLineBreak+
+'    position: -webkit-sticky; '+ sLineBreak+
+'    position: sticky; '+ sLineBreak+
+'    top: 0; '+ sLineBreak+
+'    z-index: 1020; '+ sLineBreak+
+'  } '+ sLineBreak+
+'} '
+);
+end;
+
 
 
 { TTestBaseCSSParser }
 { TTestBaseCSSParser }
 
 
@@ -768,8 +824,24 @@ begin
     AssertEquals('Selector '+IntToStr(aIndex)+'name',aName,TCSSStringElement(Result).Value)
     AssertEquals('Selector '+IntToStr(aIndex)+'name',aName,TCSSStringElement(Result).Value)
   else
   else
     Fail('Selector '+IntToStr(aIndex)+' has no known type')
     Fail('Selector '+IntToStr(aIndex)+' has no known type')
+end;
 
 
+function TTestBaseCSSParser.CheckList(aList: TCSSListElement; aIndex: Integer): TCSSElement;
+begin
+  AssertTrue('Have list index '+IntToStr(aIndex),aIndex<aList.ChildCount);
+  Result:=aList[aIndex];
+  AssertNotNull('Have element non-nil',Result);
+end;
 
 
+function TTestBaseCSSParser.CheckList(aList: TCSSListElement; aIndex: Integer; const aName: String): TCSSElement;
+begin
+  Result:=CheckList(aList,aIndex);
+  if Result is TCSSIdentifierElement then
+    AssertEquals('List element '+IntToStr(aIndex)+'name',aName,TCSSIdentifierElement(Result).Name)
+  else if Result is TCSSStringElement then
+    AssertEquals('List element '+IntToStr(aIndex)+'name',aName,TCSSStringElement(Result).Value)
+  else
+    Fail('List element '+IntToStr(aIndex)+' has no known type')
 end;
 end;
 
 
 function TTestBaseCSSParser.CheckLiteral(Msg: String; aEl: TCSSelement; aValue: String): TCSSStringElement;
 function TTestBaseCSSParser.CheckLiteral(Msg: String; aEl: TCSSelement; aValue: String): TCSSStringElement;

+ 1 - 2
packages/fcl-css/tests/testcss.lpr

@@ -3,8 +3,7 @@ program testcss;
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 
 uses
 uses
-  Classes, consoletestrunner, tccssScanner,
-tccssparser, tccsstree;
+  Classes, consoletestrunner, tccssScanner, tccssparser, tccsstree;
 
 
 type
 type