fcl-passrc: anonymous functions: forbid semicolon in modifiers

git-svn-id: trunk@40514 -

packages/fcl-passrc/src/pasresolver.pp

@@ -210,8 +210,16 @@ Works:
 - type alias type overloads
 - $writeableconst off $J-
 - $warn identifier ON|off|error|default
+- anonymous methods:
+  - assign in proc and program begin and initialization   p:=procedure begin end
+  - pass as arg  doit(procedure begin end)
+  - modifiers  assembler varargs cdecl
 
 ToDo:
+- anonymous methods:
+  - with
+  - typecast
+  - self
 - Include/Exclude for set of int/char/bool
 - set of CharRange
 - error if property method resolution is not used
@@ -224,7 +232,6 @@ ToDo:
   - CharSet:=[#13]
 - proc: check if forward and impl default values match
 - call array of proc without ()
-- anonymous functions
 - attributes
 - object
 - type helpers
@@ -811,7 +818,7 @@ type
 
   { TPasInitialFinalizationScope - e.g. TInitializationSection, TFinalizationSection }
 
-  TPasInitialFinalizationScope = Class(TPasScope)
+  TPasInitialFinalizationScope = Class(TPasIdentifierScope)
   public
     References: TPasScopeReferences; // created by TPasAnalyzer, not used by resolver
     function AddReference(El: TPasElement; Access: TPSRefAccess): TPasScopeReference;

packages/fcl-passrc/src/pparser.pp

@@ -1161,7 +1161,6 @@ begin
         end;
     ParseExcTokenError(S);
     end;
-
 end;
 
 
@@ -1253,15 +1252,9 @@ end;
 function TPasParser.TokenIsAnonymousProcedureModifier(Parent: TPasElement;
   S: String; out PM: TProcedureModifier): Boolean;
 begin
-  S:=LowerCase(S);
-  case S of
-  'assembler':
-    begin
-    PM:=pmAssembler;
-    exit(true);
-    end;
-  end;
-  Result:=false;
+  Result:=IsProcModifier(S,PM);
+  if not Result then exit;
+  Result:=PM in [pmAssembler];
   if Parent=nil then ;
 end;
 
@@ -1319,11 +1312,7 @@ function TPasParser.IsAnonymousProcAllowed(El: TPasElement): boolean;
 begin
   while El is TPasExpr do
     El:=El.Parent;
-  if not (El is TPasImplBlock) then
-    exit(false); // only in statements
-  while El is TPasImplBlock do
-    El:=El.Parent;
-  Result:=El is TProcedureBody; // needs a parent procedure
+  Result:=El is TPasImplBlock; // only in statements
 end;
 
 function TPasParser.CheckPackMode: TPackMode;
@@ -2268,18 +2257,16 @@ begin
       end;
     tkprocedure,tkfunction:
       begin
+      if not IsAnonymousProcAllowed(AParent) then
+        ParseExcExpectedIdentifier;
       if CurToken=tkprocedure then
         ProcType:=ptAnonymousProcedure
       else
         ProcType:=ptAnonymousFunction;
-      if not IsAnonymousProcAllowed(AParent) then
-        ParseExcExpectedIdentifier;
       ok:=false;
       try
         Result:=TProcedureExpr(CreateElement(TProcedureExpr,'',AParent,visPublic));
         TProcedureExpr(Result).Proc:=TPasAnonymousProcedure(ParseProcedureOrFunctionDecl(Result,ProcType));
-        if CurToken=tkSemicolon then
-          NextToken; // skip optional semicolon
         ok:=true;
       finally
         if not ok then
@@ -4879,8 +4866,8 @@ Var
   PM : TProcedureModifier;
   ResultEl: TPasResultElement;
   OK: Boolean;
-  IsProc: Boolean; // true = procedure, false = procedure type
-  IsAnonymProc: Boolean;
+  IsProcType: Boolean; // false = procedure, true = procedure type
+  IsAnonymous: Boolean;
   PTM: TProcTypeModifier;
   ModTokenCount: Integer;
   LastToken: TToken;
@@ -4889,8 +4876,8 @@ begin
   // Element must be non-nil. Removed all checks for not-nil.
   // If it is nil, the following fails anyway.
   CheckProcedureArgs(Element,Element.Args,ProcType);
-  IsProc:=Parent is TPasProcedure;
-  IsAnonymProc:=IsProc and (ProcType in [ptAnonymousProcedure,ptAnonymousFunction]);
+  IsProcType:=not (Parent is TPasProcedure);
+  IsAnonymous:=(not IsProcType) and (ProcType in [ptAnonymousProcedure,ptAnonymousFunction]);
   case ProcType of
     ptFunction,ptClassFunction,ptAnonymousFunction:
       begin
@@ -4903,7 +4890,8 @@ begin
       // 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)
+      else if (not IsAnonymous)
+          and (msDelphi in CurrentModeswitches)
           and (Assigned(CurModule.ImplementationSection)
             or (CurModule is TPasProgram))
           then
@@ -4962,12 +4950,13 @@ begin
       UnGetToken;
     end;
   ModTokenCount:=0;
+  //writeln('TPasParser.ParseProcedureOrFunctionHeader IsProcType=',IsProcType,' IsAnonymous=',IsAnonymous);
   Repeat
     inc(ModTokenCount);
-    // Writeln(ModTokenCount, curtokentext);
+    //writeln('TPasParser.ParseProcedureOrFunctionHeader ',ModTokenCount,' ',CurToken,' ',CurTokenText);
     LastToken:=CurToken;
     NextToken;
-    if (CurToken = tkEqual) and not IsProc and (ModTokenCount<=3) then
+    if (CurToken = tkEqual) and IsProcType and (ModTokenCount<=3) then
       begin
       // for example: const p: procedure = nil;
       UngetToken;
@@ -4976,6 +4965,8 @@ begin
       end;
     If CurToken=tkSemicolon then
       begin
+      if IsAnonymous then
+        CheckToken(tkbegin); // begin expected, but ; found
       if LastToken=tkSemicolon then
         ParseExcSyntaxError;
       continue;
@@ -4997,22 +4988,25 @@ begin
           NextToken; // remove offset
           end;
       end;
-      if IsProc then
-        ExpectTokens([tkSemicolon])
-      else
+      if IsProcType then
         begin
         ExpectTokens([tkSemicolon,tkEqual]);
         if CurToken=tkEqual then
           UngetToken;
-        end;
+        end
+      else if IsAnonymous then
+      else
+        ExpectTokens([tkSemicolon]);
       end
-    else if IsAnonymProc and TokenIsAnonymousProcedureModifier(Parent,CurTokenString,PM) then
-      HandleProcedureModifier(Parent,PM)
-    else if IsProc and not IsAnonymProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
+    else if IsAnonymous and TokenIsAnonymousProcedureModifier(Parent,CurTokenString,PM) then
       HandleProcedureModifier(Parent,PM)
     else if TokenIsProcedureTypeModifier(Parent,CurTokenString,PTM) then
       HandleProcedureTypeModifier(Element,PTM)
-    else if (CurToken=tklibrary) then // library is a token and a directive.
+    else if (not IsProcType) and (not IsAnonymous)
+        and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
+      HandleProcedureModifier(Parent,PM)
+    else if (CurToken=tklibrary) and not IsProcType and not IsAnonymous then
+      // library is a token and a directive.
       begin
       Tok:=UpperCase(CurTokenString);
       NextToken;
@@ -5028,10 +5022,10 @@ begin
         ExpectToken(tkSemicolon);
         end;
       end
-    else if (not IsAnonymProc) and DoCheckHint(Element) then
+    else if (not IsAnonymous) and DoCheckHint(Element) then
       // deprecated,platform,experimental,library, unimplemented etc
       ConsumeSemi
-    else if (CurToken=tkIdentifier) and (not IsAnonymProc)
+    else if (CurToken=tkIdentifier) and (not IsAnonymous)
         and (CompareText(CurTokenText,'alias')=0) then
       begin
       ExpectToken(tkColon);
@@ -5065,11 +5059,11 @@ begin
       if LastToken=tkSemicolon then
         begin
         UngetToken;
-        if IsAnonymProc and (ModTokenCount<=1) then
+        if IsAnonymous then
           ParseExcSyntaxError;
         break;
         end
-      else if IsAnonymProc then
+      else if IsAnonymous then
         begin
         UngetToken;
         break;
@@ -5085,15 +5079,15 @@ begin
   if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
     TPasOperator(Parent).CorrectName;
   Engine.FinishScope(stProcedureHeader,Element);
-  if IsProc
+  if (not IsProcType)
   and (not TPasProcedure(Parent).IsForward)
   and (not TPasProcedure(Parent).IsExternal)
   and ((Parent.Parent is TImplementationSection)
      or (Parent.Parent is TProcedureBody)
-     or IsAnonymProc)
+     or IsAnonymous)
   then
     ParseProcedureBody(Parent);
-  if IsProc then
+  if not IsProcType then
     Engine.FinishScope(stProcedure,Parent);
 end;
 

packages/fcl-passrc/src/pscanner.pp

@@ -531,6 +531,8 @@ type
     function FindStream(const AName: string; ScanIncludes: Boolean): TStream;
     function FindStreamReader(const AName: string; ScanIncludes: Boolean): TLineReader;
     procedure SetOwnsStreams(AValue: Boolean);
+  Protected
+    function FindIncludeFileName(const aFilename: string): String; override;
   Public
     constructor Create; override;
     destructor Destroy; override;
@@ -2540,6 +2542,12 @@ begin
   FOwnsStreams:=AValue;
 end;
 
+function TStreamResolver.FindIncludeFileName(const aFilename: string): String;
+begin
+  raise EFileNotFoundError.Create('TStreamResolver.FindIncludeFileName not supported '+aFilename);
+  Result:='';
+end;
+
 constructor TStreamResolver.Create;
 begin
   Inherited;

packages/fcl-passrc/tests/tcresolver.pas

@@ -448,23 +448,23 @@ type
     Procedure TestProc_Absolute;
 
     // anonymous procs
-    // ToDo: fppas2js: check "is TPasFunction", ".FuncType", "parent is TPasProcedureBody"
     Procedure TestAnonymousProc_Assign;
-    // ToDo: does Delphi allow/require semicolon in assign?
+    Procedure TestAnonymousProc_AssignSemicolonFail;
     Procedure TestAnonymousProc_Arg;
-    // ToDo: does Delphi allow/require semicolon in arg?
-    // ToDo: does Delphi allow calling directly?: function(i: word):word begin end(3)
+    Procedure TestAnonymousProc_ArgSemicolonFail;
     Procedure TestAnonymousProc_EqualFail;
-    // ToDo: does Delphi allow ano proc in const?
     Procedure TestAnonymousProc_ConstFail;
-    // ToDo: does Delphi allow assembler or calling conventions?
     Procedure TestAnonymousProc_Assembler;
     Procedure TestAnonymousProc_NameFail;
     Procedure TestAnonymousProc_StatementFail;
+    // ToDo: Delphi does not support calling directly: function(i: word):word begin end(3)
+    // ToDo: Delphi does support calling with typecast: TFunc(function(i: word):word begin end)(3)
     Procedure TestAnonymousProc_Typecast;// ToDo
-    // ToDo: ano in with
+    // ToDo: ano in with (ano proc can access with scope)
     // ToDo: ano in nested
     // ToDo: ano in ano
+    // ToDo: ano in except E: Exception do ..
+    // ToDo: fppas2js: check "is TPasFunction", ".FuncType", "is TPasProcedureBody"
 
     // record
     Procedure TestRecord;
@@ -7168,13 +7168,35 @@ begin
   '    Result:=a+b;',
   '    exit(b);',
   '    exit(Result);',
-  '  end;',
-  '  a:=3;',// test semicolon
+  '  end;',// test semicolon
+  '  a:=3;',
   'end;',
-  'begin']);
+  'begin',
+  '  Func:=function(c:word):word begin',
+  '    Result:=3+c;',
+  '    exit(c);',
+  '    exit(Result);',
+  '  end;']);
   ParseProgram;
 end;
 
+procedure TTestResolver.TestAnonymousProc_AssignSemicolonFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'procedure DoIt(a: word);',
+  'var p: TProc;',
+  'begin',
+  '  p:=procedure; begin end;',
+  '  a:=3;',
+  'end;',
+  'begin']);
+  CheckParserException('Expected "begin" at token ";" in file afile.pp at line 7 column 15',
+    nParserExpectTokenError);
+end;
+
 procedure TTestResolver.TestAnonymousProc_Arg;
 begin
   StartProgram(false);
@@ -7190,13 +7212,30 @@ begin
   '  DoIt(function(b:word): word',
   '    begin',
   '      Result:=1+b;',
-  '    end;);',
-  '  DoMore(procedure begin end;, procedure begin end);',
+  '    end);',
+  '  DoMore(procedure begin end, procedure begin end);',
   'end;',
-  'begin']);
+  'begin',
+  '  DoMore(procedure begin end, procedure begin end);',
+  '']);
   ParseProgram;
 end;
 
+procedure TTestResolver.TestAnonymousProc_ArgSemicolonFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'procedure DoIt(p: TProc);',
+  'begin',
+  'end;',
+  'begin',
+  '  DoIt(procedure begin end;);']);
+  CheckParserException('Expected "," at token ";" in file afile.pp at line 8 column 27',
+    nParserExpectTokenError);
+end;
+
 procedure TTestResolver.TestAnonymousProc_EqualFail;
 begin
   StartProgram(false);
@@ -7209,7 +7248,7 @@ begin
   '  if w=function(b:word): word',
   '    begin',
   '      Result:=1+b;',
-  '    end; then ;',
+  '    end then ;',
   'end;',
   'begin']);
   CheckResolverException('Incompatible types: got "Procedure/Function" expected "Word"',nIncompatibleTypesGotExpected);
@@ -7233,10 +7272,13 @@ begin
   Add([
   'type',
   '  TProc = reference to procedure;',
+  '  TProcB = reference to procedure cdecl;',
   'procedure DoIt(p: TProc);',
+  'var b: TProcB;',
   'begin',
-  '  p:=procedure assembler; asm end;',
-  '  p:=procedure() assembler; asm end;',
+  '  p:=procedure assembler asm end;',
+  '  p:=procedure() assembler asm end;',
+  '  b:=procedure() cdecl assembler asm end;',
   'end;',
   'begin']);
   ParseProgram;