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

git-svn-id: trunk@35524 -

packages/fcl-passrc/src/pparser.pp

@@ -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
+          OK:=FindInSection(Parent.Name,CurModule.InterfaceSection)
-          // ToDo: add an event for the resolver to use a faster lookup
+        else if (CurModule is TPasProgram) and Assigned(TPasProgram(CurModule).ProgramSection) then
-          I:=CurModule.InterfaceSection.Functions.Count-1;
+          OK:=FindInSection(Parent.Name,TPasProgram(CurModule).ProgramSection);
-          While (I>=0) and (CompareText(TPasElement(CurModule.InterfaceSection.Functions[i]).Name,Parent.Name)<>0) do
+        if Not OK then
-            Dec(I);
-          end;
-        if (I=-1) 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);

packages/fcl-passrc/tests/tcprocfunc.pas

@@ -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''','');