paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 23:19:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix parsing of bootstrap

Browse Source
This commit is contained in:
Michaël Van Canneyt 2022-03-28 13:52:31 +02:00
parent 2dcca2eb68
commit 8b9c7b8254
4 changed files with 119 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
packages/fcl-css/src/fpcssparser.pp
View File

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

2
packages/fcl-css/src/fpcsstree.pp
View File

@ -235,7 +235,7 @@ Type
Public
Destructor Destroy; override;
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;
end;

106
packages/fcl-css/tests/tccssparser.pp
View File

@ -47,6 +47,8 @@ type
Function CheckDeclaration(aRule : TCSSRuleElement; aIndex : Integer; const AKey : String) : TCSSDeclarationElement;
Function CheckSelector(aRule : TCSSRuleElement; aIndex : Integer) : 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: Integer) : TCSSIntegerElement; overload;
function CheckLiteral(Msg: String; aEl: TCSSelement; aValue: Integer; AUnits : TCSSUnits) : TCSSIntegerElement; overload;
@ -70,6 +72,8 @@ type
procedure TestDoublePrefixedEmptyRule;
procedure TestDoubleMixedPrefixedEmptyRule;
procedure TestAttributePrefixedEmptyRule;
procedure TestPseudoPrefixedEmptyRule;
procedure TestPseudoFunctionEmptyRule;
procedure TestFuncPrefixedEmptyRule;
procedure TestQueryPrefixedEmptyRule;
Procedure TestCommaPrefixedEmptyRule;
@ -88,6 +92,7 @@ type
Procedure TestOneEmptyDeclaration;
Procedure TestImportAtKeyWord;
Procedure TestMediaPrint;
Procedure TestSupportsFunction;
end;
{ TTestCSSFilesParser }
@ -355,16 +360,19 @@ procedure TTestCSSParser.TestDoublePrefixedEmptyRule;
var
R : TCSSRuleElement;
sel: TCSSIdentifierElement;
List : TCSSListElement;
begin
ParseRule('a b { }');
R:=TCSSRuleElement(CheckClass('Rule',TCSSRuleElement,FirstRule));
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;
procedure TTestCSSParser.TestDoubleMixedPrefixedEmptyRule;
@ -372,17 +380,19 @@ procedure TTestCSSParser.TestDoubleMixedPrefixedEmptyRule;
var
R : TCSSRuleElement;
sel: TCSSIdentifierElement;
sel2: TCSSClassNameElement;
List : TCSSListElement;
begin
ParseRule('a .b { }');
R:=TCSSRuleElement(CheckClass('Rule',TCSSRuleElement,FirstRule));
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;
procedure TTestCSSParser.TestAttributePrefixedEmptyRule;
@ -405,20 +415,53 @@ begin
AssertEquals('Binary op',boEquals,Bin.Operation);
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;
var
R : TCSSRuleElement;
sel: TCSSArrayElement;
List : TCSSListElement;
begin
R:=ParseRule('input:enabled:read-write:-webkit-any(:focus,:hover)::-webkit-clear-button { }');
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;
procedure TTestCSSParser.TestQueryPrefixedEmptyRule;
@ -630,6 +673,19 @@ begin
ParseRule('@media print { *, *:before {} }');
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 }
@ -768,8 +824,24 @@ begin
AssertEquals('Selector '+IntToStr(aIndex)+'name',aName,TCSSStringElement(Result).Value)
else
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;
function TTestBaseCSSParser.CheckLiteral(Msg: String; aEl: TCSSelement; aValue: String): TCSSStringElement;

3
packages/fcl-css/tests/testcss.lpr
View File

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