I got the Lazarus sources on svn and I'm not sure how to make a diff! Here are
changes I propose to allow generic constants (I believe this is Mattias's code
so he'll understand). It's just a few lines in a single function. Not sure
about the error message but I think this is more or less the right idea. Let me
know how we can get this integrated. Thanks.
procedure TPascalParserTool.ReadGenericParamList(Must, AllowConstraints:
boolean);
{ At start cursor is on <
At end cursor is on atom after >
Examples:
<> = type; // fpc style
<name>=type; // this is the only case where >= are two operators
<name,name> = type; // delphi style
<T1: record; T2,T3: class; T4: constructor; T5: name> = type
}
var
RequiresConstraint: boolean = false;
HasConstraint: boolean = false;
begin
if not AtomIsChar('<') then begin
if Must then
SaveRaiseCharExpectedButAtomFound(20171106143341,'<');
exit;
end else if not (Scanner.CompilerMode in cmAllModesWithGeneric) then
exit;
CreateChildNode;
CurNode.Desc:=ctnGenericParams;
ReadNextAtom;
// param is a constant which requires constraints
if UpAtomIs('CONST') then
begin
RequiresConstraint:=true;
ReadNextAtom;
end;
//debugln(['TPascalParserTool.ReadGenericParamList START ctnGenericParams
',GetAtom]);
if AtomIsIdentifier then begin
CreateChildNode;
CurNode.Desc:=ctnGenericParameter;
CurNode.EndPos:=CurPos.EndPos;
ReadNextAtom;
repeat
// read name
//debugln(['TPascalParserTool.ReadGenericParamList AFTER NAMESTART
ctnGenericParams ',GetAtom]);
if AtomIs('>=') then begin
// this is the rare case where >= are two separate atoms
dec(CurPos.EndPos);
end;
if CurPos.Flag in [cafComma,cafSemicolon] then begin
// read next name
EndChildNode;
ReadNextAtom;
AtomIsIdentifierSaveE(20180411194201);
CreateChildNode;
CurNode.Desc:=ctnGenericParameter;
CurNode.EndPos:=CurPos.EndPos;
ReadNextAtom;
end else if AtomIsChar('>') then begin
break;
end else if AllowConstraints and (CurPos.Flag=cafColon) then begin
// read constraints
HasConstraint:=true;
ReadNextAtom;
if CurPos.Flag<>cafNone then begin
CreateChildNode;
CurNode.Desc:=ctnGenericConstraint;
end;
repeat
CurNode.EndPos:=CurPos.EndPos;
CurNode.Parent.EndPos:=CurPos.EndPos;
if UpAtomIs('RECORD') or UpAtomIs('CLASS') or UpAtomIs('CONSTRUCTOR')
then begin
// keyword
ReadNextAtom;
end else begin
// a type
AtomIsIdentifierSaveE(20180411194204);
ReadNextAtom;
end;
if AtomIs('>=') then begin
// this is the rare case where >= are two separate atoms
dec(CurPos.EndPos);
end;
if (CurPos.Flag=cafSemicolon) or AtomIsChar('>') then begin
break;
end else if CurPos.Flag<>cafComma then
SaveRaiseCharExpectedButAtomFound(20170421195740,'>');
ReadNextAtom;
until false;
// close ctnGenericConstraint
EndChildNode;
if AtomIsChar('>') then break;
// cursor is now on ;
end else
SaveRaiseCharExpectedButAtomFound(20170421195742,'>');
until false;
// give an error if no constraint was found
// note(ryan): what error should be given, any error at all??
if RequiresConstraint and not HasConstraint then
SaveRaiseUnexpectedKeyWord(20170421195742);
RequiresConstraint:=false;
HasConstraint:=false;
// close ctnGenericParameter
EndChildNode;
end else begin
if AtomIs('>=') then begin
// this is the rare case where >= are two separate atoms
dec(CurPos.EndPos);
LastAtoms.SetCurrent(CurPos);
end;
if not AtomIsChar('>') then
SaveRaiseCharExpectedButAtomFound(20170421195745,'>');
end;
// close ctnGenericParams
CurNode.EndPos:=CurPos.EndPos;
EndChildNode;
ReadNextAtom;
end;
Regards,
Ryan Joseph
_______________________________________________
fpc-pascal maillist - [email protected]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
