Browse Source

fcl-pasrc: resolver: mode delphi allow typecast anonymous proc

git-svn-id: trunk@40531 -
Mattias Gaertner 6 years ago
parent
commit
18f77f671b
2 changed files with 29 additions and 4 deletions
  1. 3 2
      packages/fcl-passrc/src/pasresolver.pp
  2. 26 2
      packages/fcl-passrc/tests/tcresolver.pas

+ 3 - 2
packages/fcl-passrc/src/pasresolver.pp

@@ -19374,8 +19374,9 @@ begin
           // typecast procedure (or anonymous procedure) to proctype
           // typecast procedure (or anonymous procedure) to proctype
           FromProcType:=TPasProcedureType(FromTypeEl);
           FromProcType:=TPasProcedureType(FromTypeEl);
           if (msDelphi in CurrentParser.CurrentModeswitches)
           if (msDelphi in CurrentParser.CurrentModeswitches)
-              and (FromResolved.IdentEl=nil) then
-            // Delphi forbids typecast procedure to proctype
+              and (FromResolved.IdentEl=nil)
+              and (FromResolved.LoTypeEl.Name<>'') then
+            // Delphi forbids typecast (non anonymous) procedure to proctype
           else if ToProcType.IsReferenceTo then
           else if ToProcType.IsReferenceTo then
             Result:=cCompatible
             Result:=cCompatible
           else if FromResolved.IdentEl=nil then
           else if FromResolved.IdentEl=nil then

+ 26 - 2
packages/fcl-passrc/tests/tcresolver.pas

@@ -457,7 +457,8 @@ type
     Procedure TestAnonymousProc_Assembler;
     Procedure TestAnonymousProc_Assembler;
     Procedure TestAnonymousProc_NameFail;
     Procedure TestAnonymousProc_NameFail;
     Procedure TestAnonymousProc_StatementFail;
     Procedure TestAnonymousProc_StatementFail;
-    Procedure TestAnonymousProc_Typecast;
+    Procedure TestAnonymousProc_Typecast_ObjFPC;
+    Procedure TestAnonymousProc_Typecast_Delphi;
     Procedure TestAnonymousProc_TypecastToResultFail;
     Procedure TestAnonymousProc_TypecastToResultFail;
     Procedure TestAnonymousProc_With;
     Procedure TestAnonymousProc_With;
     Procedure TestAnonymousProc_ExceptOn;
     Procedure TestAnonymousProc_ExceptOn;
@@ -7307,10 +7308,33 @@ begin
   CheckParserException(SParserSyntaxError,nParserSyntaxError);
   CheckParserException(SParserSyntaxError,nParserSyntaxError);
 end;
 end;
 
 
-procedure TTestResolver.TestAnonymousProc_Typecast;
+procedure TTestResolver.TestAnonymousProc_Typecast_ObjFPC;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
+  '{$mode ObjFPC}',
+  'type',
+  '  TProc = reference to procedure(w: word);',
+  '  TArr = array of word;',
+  '  TFuncArr = reference to function: TArr;',
+  'procedure DoIt(p: TProc);',
+  'var',
+  '  w: word;',
+  '  a: TArr;',
+  'begin',
+  '  p:=TProc(procedure(b: smallint) begin end);',
+  '  a:=TFuncArr(function: TArr begin end)();',
+  '  w:=TFuncArr(function: TArr begin end)()[3];',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAnonymousProc_Typecast_Delphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode Delphi}',
   'type',
   'type',
   '  TProc = reference to procedure(w: word);',
   '  TProc = reference to procedure(w: word);',
   '  TArr = array of word;',
   '  TArr = array of word;',