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

* Fix bug #31294. Function does not need result in delphi mode, in program or object

Browse Source 
git-svn-id: trunk@35524 -
This commit is contained in:
michael 2017-03-05 12:13:58 +00:00
parent a8ba81a585
commit 6a1d01b352
2 changed files with 81 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -239,6 +239,7 @@ type
function CheckOverloadList(AList: TFPList; AName: String; out OldMember: TPasElement): TPasOverloadedProc;
procedure DumpCurToken(Const Msg : String; IndentAction : TIndentAction = iaNone);
function GetCurrentModeSwitches: TModeSwitches;
Procedure SetCurrentModeSwitches(AValue: TModeSwitches);
function GetVariableModifiers(Parent: TPasElement; Out VarMods: TVariableModifiers; Out LibName, ExportName: TPasExpr): string;
function GetVariableValueAndLocation(Parent : TPasElement; Out Value : TPasExpr; Out Location: String): Boolean;
procedure HandleProcedureModifier(Parent: TPasElement; pm : TProcedureModifier);
@ -382,7 +383,7 @@ type
property CurToken: TToken read FCurToken;
property CurTokenString: String read FCurTokenString;
Property Options : TPOptions Read FOptions Write SetOptions;
Property CurrentModeswitches : TModeSwitches Read GetCurrentModeSwitches;
Property CurrentModeswitches : TModeSwitches Read GetCurrentModeSwitches Write SetCurrentModeSwitches;
Property CurModule : TPasModule Read FCurModule;
Property LogEvents : TPParserLogEvents Read FLogEvents Write FLogEvents;
Property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
@ -3478,6 +3479,35 @@ end;
procedure TPasParser.ParseProcedureOrFunctionHeader(Parent: TPasElement;
Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
Function FindInSection(AName : String;ASection : TPasSection) : Boolean;
Var
I : integer;
Cn,FN : String;
CT : TPasClassType;
begin
// ToDo: add an event for the resolver to use a faster lookup
I:=ASection.Functions.Count-1;
While (I>=0) and (CompareText(TPasElement(ASection.Functions[I]).Name,AName)<>0) do
Dec(I);
Result:=I<>-1;
I:=Pos('.',AName);
if (Not Result) and (I<>0) then
begin
CN:=Copy(AName,1,I-1);
FN:=Aname;
Delete(FN,1,I);
I:=Asection.Classes.Count-1;
While Not Result and (I>=0) do
begin
CT:=TPasClassType(ASection.Classes[i]);
if CompareText(CT.Name,CN)=0 then
Result:=CT.FindMember(TPasFunction, FN)<>Nil;
Dec(I);
end;
end;
end;
procedure ConsumeSemi;
begin
NextToken;
@ -3512,6 +3542,7 @@ Var
Done: Boolean;
ResultEl: TPasResultElement;
I : Integer;
OK : Boolean;
begin
// Element must be non-nil. Removed all checks for not-nil.
@ -3528,17 +3559,15 @@ begin
end
// In Delphi mode, the implementation in the implementation section can be without result as it was declared
// We actually check if the function exists in the interface section.
else if (msDelphi in CurrentModeswitches) and Assigned(CurModule.ImplementationSection) then
else if (msDelphi in CurrentModeswitches) and
(Assigned(CurModule.ImplementationSection) or
(CurModule is TPasProgram)) then
begin
I:=-1;
if Assigned(CurModule.InterfaceSection) then
begin
// ToDo: add an event for the resolver to use a faster lookup
I:=CurModule.InterfaceSection.Functions.Count-1;
While (I>=0) and (CompareText(TPasElement(CurModule.InterfaceSection.Functions[i]).Name,Parent.Name)<>0) do
Dec(I);
end;
if (I=-1) then
OK:=FindInSection(Parent.Name,CurModule.InterfaceSection)
else if (CurModule is TPasProgram) and Assigned(TPasProgram(CurModule).ProgramSection) then
OK:=FindInSection(Parent.Name,TPasProgram(CurModule).ProgramSection);
if Not OK then
CheckToken(tkColon)
else
begin
@ -4621,6 +4650,12 @@ begin
Result:=[msNone];
end;
procedure TPasParser.SetCurrentModeSwitches(AValue: TModeSwitches);
begin
if Assigned(FScanner) then
FScanner.CurrentModeSwitches:=AValue;
end;
// Starts on first token after Record or (. Ends on AEndToken
procedure TPasParser.ParseRecordFieldList(ARec: TPasRecordType;
AEndToken: TToken; AllowMethods: Boolean);

36
packages/fcl-passrc/tests/tcprocfunc.pas
View File

@ -28,6 +28,7 @@ type
procedure AssertProc(Mods: TProcedureModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasProcedure=nil);
function BaseAssertArg(ProcType: TPasProcedureType; AIndex: Integer;
AName: String; AAccess: TArgumentAccess; AValue: String=''): TPasArgument;
procedure CreateForwardTest;
function GetFT: TPasFunctionType;
function GetPT: TPasProcedureType;
Procedure ParseProcedure;
@ -146,6 +147,8 @@ type
Procedure TestFunctionCDeclExport;
Procedure TestProcedureExternal;
Procedure TestFunctionExternal;
Procedure TestFunctionForwardNoReturnDelphi;
procedure TestFunctionForwardNoReturnNoDelphi;
Procedure TestProcedureExternalLibName;
Procedure TestFunctionExternalLibName;
Procedure TestProcedureExternalLibNameName;
@ -1055,6 +1058,39 @@ begin
AssertNull('No Library name expression',Func.LibraryExpr);
end;
procedure TTestProcedureFunction.CreateForwardTest;
begin
With Source do
begin
Add('type');
Add('');
Add('Entity=object');
Add(' function test:Boolean;');
Add('end;');
Add('');
Add('Function Entity.test;');
Add('begin');
Add('end;');
Add('');
Add('begin');
// End is added by ParseModule
end;
end;
procedure TTestProcedureFunction.TestFunctionForwardNoReturnDelphi;
begin
Source.Add('{$MODE DELPHI}');
CreateForwardTest;
ParseModule;
end;
procedure TTestProcedureFunction.TestFunctionForwardNoReturnNoDelphi;
begin
CreateForwardTest;
AssertException('Only in delphi mode can result be omitted',EParserError,@ParseModule);
end;
procedure TTestProcedureFunction.TestProcedureExternalLibName;
begin
ParseProcedure(';external ''libname''','');