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

* Patch from Mattias Gaertner, implementing

Browse Source 
*  with..do
  * is and as operator for class
  * inherited call
  * basic type checks for binary operators
  * type checks for if..then, while..do, repeat..until, on..do, raise

git-svn-id: trunk@34569 -
This commit is contained in:
michael 2016-09-27 19:15:27 +00:00
parent 7f3ac8bf51
commit ea421c6874
9 changed files with 2585 additions and 886 deletions

2009
packages/fcl-passrc/src/pasresolver.pp
View File

File diff suppressed because it is too large Load Diff

513
packages/fcl-passrc/src/pastree.pp
View File

File diff suppressed because it is too large Load Diff

56
packages/fcl-passrc/src/pparser.pp
View File

@ -73,6 +73,7 @@ const
nParserDuplicateIdentifier = 2046;
nParserDefaultParameterRequiredFor = 2047;
nParserOnlyOneVariableCanBeInitialized = 2048;
nParserExpectedTypeButGot = 2049;
// resourcestring patterns of messages
@ -125,6 +126,7 @@ resourcestring
SParserDuplicateIdentifier = 'Duplicate identifier "%s"';
SParserDefaultParameterRequiredFor = 'Default parameter required for "%s"';
SParserOnlyOneVariableCanBeInitialized = 'Only one variable can be initialized';
SParserExpectedTypeButGot = 'Expected type, but got %s';
type
TPasScopeType = (
@ -1088,7 +1090,21 @@ begin
Ref:=Nil;
SS:=(not (po_resolvestandardtypes in FOptions)) and isSimpleTypeToken(Name);
if not SS then
begin
Ref:=Engine.FindElement(Name);
if Ref=nil then
begin
{$IFDEF VerbosePasResolver}
if po_resolvestandardtypes in FOptions then
begin
writeln('ERROR: TPasParser.ParseSimpleType resolver failed to raise an error');
ParseExcExpectedIdentifier;
end;
{$ENDIF}
end
else if not (Ref is TPasType) then
ParseExc(nParserExpectedTypeButGot,SParserExpectedTypeButGot,[Ref.ElementTypeName]);
end;
if (Ref=Nil) then
Ref:=TPasUnresolvedTypeRef(CreateElement(TPasUnresolvedTypeRef,Name,Parent))
else
@ -2341,7 +2357,8 @@ begin
if Assigned(TypeEl) then // !!!
begin
Declarations.Declarations.Add(TypeEl);
if TypeEl.ClassType = TPasClassType then
if (TypeEl.ClassType = TPasClassType)
and (not (po_keepclassforward in Options)) then
begin
// Remove previous forward declarations, if necessary
for i := 0 to Declarations.Classes.Count - 1 do
@ -2407,7 +2424,7 @@ begin
begin
PropEl:=ParseProperty(Declarations,CurtokenString,visDefault);
Declarations.Declarations.Add(PropEl);
Declarations.properties.add(PropEl);
Declarations.properties.Add(PropEl);
end;
else
ParseExcSyntaxError;
@ -3666,6 +3683,9 @@ var
ak : TAssignKind;
lt : TLoopType;
ok: Boolean;
SrcPos: TPasSourcePos;
Name: String;
TypeEl: TPasType;
begin
NewImplElement:=nil;
@ -3819,10 +3839,11 @@ begin
begin
// with Expr do
// with Expr, Expr do
SrcPos:=Scanner.CurSourcePos;
NextToken;
Left:=DoParseExpression(Parent);
//writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock));
El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
TPasImplWithDo(El).AddExpression(Left);
CreateBlock(TPasImplWithDo(El));
repeat
@ -3955,23 +3976,28 @@ begin
// on Exception do
if CurBlock is TPasImplTryExcept then
begin
ExpectIdentifier;
El:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock));
SrcPos:=Scanner.CurSourcePos;
Name:=CurTokenString;
NextToken;
Left:=Nil;
Right:=DoParseExpression(Parent);
//writeln(i,'ON t=',TypeName,' Token=',CurTokenText);
// NextToken;
//writeln('ON t=',Name,' Token=',CurTokenText);
if CurToken=tkColon then
begin
// the first expression was the variable name
NextToken;
Left:=Right;
Right:=DoParseExpression(Parent);
//writeln(i,'ON v=',VarName,' t=',TypeName,' Token=',CurTokenText);
TypeEl:=ParseSimpleType(El,SrcPos,'');
TPasImplExceptOn(El).TypeEl:=TypeEl;
TPasImplExceptOn(El).VarEl:=TPasVariable(CreateElement(TPasVariable,
Name,El,SrcPos));
TPasImplExceptOn(El).VarEl.VarType:=TypeEl;
TypeEl.AddRef;
end
else
begin
UngetToken;
TPasImplExceptOn(El).TypeEl:=ParseSimpleType(El,SrcPos,'');
end;
// else
UngetToken;
El:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock));
TPasImplExceptOn(El).VarExpr:=Left;
TPasImplExceptOn(El).TypeExpr:=Right;
Engine.FinishScope(stExceptOnExpr,El);
CurBlock.AddElement(El);
CurBlock:=TPasImplExceptOn(El);

6
packages/fcl-passrc/src/pscanner.pp
View File

@ -330,7 +330,8 @@ type
po_cassignments, // allow C-operators += -= *= /=
po_resolvestandardtypes, // search for 'longint', 'string', etc., do not use dummies, TPasResolver sets this to use its declarations
po_asmwhole, // store whole text between asm..end in TPasImplAsmStatement.Tokens
po_nooverloadedprocs // do not create TPasOverloadedProc for procs with same name
po_nooverloadedprocs, // do not create TPasOverloadedProc for procs with same name
po_keepclassforward // default: delete class fowards when there is a class declaration
);
TPOptions = set of TPOption;
@ -849,7 +850,8 @@ Procedure TStreamLineReader.InitFromStream(AStream : TStream);
begin
SetLength(FContent,AStream.Size);
AStream.Read(FContent[1],AStream.Size);
if FContent<>'' then
AStream.Read(FContent[1],length(FContent));
FPos:=0;
end;

5
packages/fcl-passrc/tests/tcbaseparser.pas
View File

@ -599,6 +599,8 @@ end;
procedure TTestParser.StartParsing;
var
i: Integer;
begin
If FIsUnit then
StartImplementation;
@ -608,7 +610,8 @@ begin
FResolver.AddStream(FFileName,TStringStream.Create(FSource.Text));
FScanner.OpenFile(FFileName);
Writeln('// Test : ',Self.TestName);
Writeln(FSource.Text);
for i:=0 to FSource.Count-1 do
Writeln(Format('%:4d: ',[i+1]),FSource[i]);
end;
procedure TTestParser.ParseDeclarations;

44
packages/fcl-passrc/tests/tcclasstype.pas
View File

@ -763,28 +763,28 @@ procedure TTestClassType.TestConstructor;
begin
AddMember('Constructor Create');
ParseClass;
AssertEquals('1 members',1,TheClass.members.Count);
AssertEquals('1 class procedure',TPasConstructor,members[0].ClassType);
AssertEquals('1 members',1,TheClass.Members.Count);
AssertEquals('1 class procedure',TPasConstructor,Members[0].ClassType);
AssertEquals('Default visibility',visDefault,Members[0].Visibility);
AssertMemberName('Create');
AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
AssertEquals('No modifiers',[],TPasConstructor(Members[0]).Modifiers);
AssertEquals('Default calling convention',ccDefault, TPasConstructor(Members[0]).ProcType.CallingConvention);
AssertNotNull('Method proc type',TPasConstructor(Members[0]).ProcType);
AssertEquals('No arguments',0,TPasConstructor(Members[0]).ProcType.Args.Count)
end;
procedure TTestClassType.TestClassConstructor;
begin
AddMember('Class Constructor Create');
ParseClass;
AssertEquals('1 members',1,TheClass.members.Count);
AssertEquals('1 class procedure',TPasClassConstructor,members[0].ClassType);
AssertEquals('1 members',1,TheClass.Members.Count);
AssertEquals('1 class procedure',TPasClassConstructor,Members[0].ClassType);
AssertEquals('Default visibility',visDefault,Members[0].Visibility);
AssertMemberName('Create');
AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
AssertEquals('No modifiers',[],TPasClassConstructor(Members[0]).Modifiers);
AssertEquals('Default calling convention',ccDefault, TPasClassConstructor(Members[0]).ProcType.CallingConvention);
AssertNotNull('Method proc type',TPasClassConstructor(Members[0]).ProcType);
AssertEquals('No arguments',0,TPasClassConstructor(Members[0]).ProcType.Args.Count)
end;
procedure TTestClassType.TestDestructor;
@ -795,24 +795,24 @@ begin
AssertEquals('1 class procedure',TPasDestructor,members[0].ClassType);
AssertEquals('Default visibility',visDefault,Members[0].Visibility);
AssertMemberName('Destroy');
AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
AssertEquals('No modifiers',[],TPasDestructor(Members[0]).Modifiers);
AssertEquals('Default calling convention',ccDefault, TPasDestructor(Members[0]).ProcType.CallingConvention);
AssertNotNull('Method proc type',TPasDestructor(Members[0]).ProcType);
AssertEquals('No arguments',0,TPasDestructor(Members[0]).ProcType.Args.Count)
end;
procedure TTestClassType.TestClassDestructor;
begin
AddMember('Class Destructor Destroy');
ParseClass;
AssertEquals('1 members',1,TheClass.members.Count);
AssertEquals('1 class procedure',TPasClassDestructor,members[0].ClassType);
AssertEquals('1 members',1,TheClass.Members.Count);
AssertEquals('1 class procedure',TPasClassDestructor,Members[0].ClassType);
AssertEquals('Default visibility',visDefault,Members[0].Visibility);
AssertMemberName('Destroy');
AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
AssertEquals('No modifiers',[],TPasClassDestructor(Members[0]).Modifiers);
AssertEquals('Default calling convention',ccDefault, TPasClassDestructor(Members[0]).ProcType.CallingConvention);
AssertNotNull('Method proc type',TPasClassDestructor(Members[0]).ProcType);
AssertEquals('No arguments',0,TPasClassDestructor(Members[0]).ProcType.Args.Count)
end;
procedure TTestClassType.TestFunctionMethodSimple;

814
packages/fcl-passrc/tests/tcresolver.pas
View File

File diff suppressed because it is too large Load Diff

20
packages/fcl-passrc/tests/tcstatements.pas
View File

@ -1326,8 +1326,8 @@ begin
O:=TPasImplExceptOn(E.Elements[0]);
AssertEquals(1,O.Elements.Count);
AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
AssertEquals('Exception Variable name','E',O.VariableName);
AssertEquals('Exception Type name','Exception',O.TypeName);
S:=TPasImplSimple(O.Elements[0]);
AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
// AssertEquals('Variable name',
@ -1364,8 +1364,8 @@ begin
O:=TPasImplExceptOn(E.Elements[0]);
AssertEquals(1,O.Elements.Count);
AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
AssertEquals('Exception Variable name','E',O.VariableName);
AssertEquals('Exception Type name','Exception',O.TypeName);
S:=TPasImplSimple(O.Elements[0]);
AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
// Exception handler 2
@ -1373,8 +1373,8 @@ begin
O:=TPasImplExceptOn(E.Elements[1]);
AssertEquals(1,O.Elements.Count);
AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'Y');
AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception2');
AssertEquals('Exception Variable name','Y',O.VariableName);
AssertEquals('Exception Type name','Exception2',O.TypeName);
S:=TPasImplSimple(O.Elements[0]);
AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse2');
end;
@ -1407,8 +1407,8 @@ begin
AssertEquals(1,E.Elements.Count);
AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[0]).ClassType);
O:=TPasImplExceptOn(E.Elements[0]);
AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
AssertEquals('Exception Variable name','E',O.VariableName);
AssertEquals('Exception Type name','Exception',O.TypeName);
AssertEquals(1,O.Elements.Count);
AssertEquals('Simple statement',TPasImplIfElse,TPasElement(O.Elements[0]).ClassType);
I:=TPasImplIfElse(O.Elements[0]);
@ -1450,8 +1450,8 @@ begin
AssertEquals(1,E.Elements.Count);
AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[0]).ClassType);
O:=TPasImplExceptOn(E.Elements[0]);
AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
AssertEquals('Exception Variable name','E',O.VariableName);
AssertEquals('Exception Type name','Exception',O.TypeName);
AssertEquals(1,O.Elements.Count);
AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
S:=TPasImplSimple(O.Elements[0]);

4
packages/pastojs/tests/tcconverter.pp
View File

@ -644,7 +644,7 @@ begin
T:=TPasImplTry.Create('',Nil);
T.AddElement(CreateAssignStatement('a','b'));
F:=T.AddExcept;
O:=F.AddExceptOn(CreateIdent('E'),CreateIdent('Exception'));
O:=F.AddExceptOn('E','Exception');
O.Body:=CreateAssignStatement('b','c');
// Convert
El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
@ -692,7 +692,7 @@ begin
T:=TPasImplTry.Create('',Nil);
T.AddElement(CreateAssignStatement('a','b'));
F:=T.AddExcept;
O:=F.AddExceptOn(CreateIdent('E'),CreateIdent('Exception'));
O:=F.AddExceptOn('E','Exception');
O.Body:=TPasImplRaise.Create('',Nil);
// Convert
El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));