fcl-passrc: fixed mem leak on error during parsing function type

packages/fcl-passrc/src/pasresolver.pp

@@ -12082,6 +12082,8 @@ begin
   CurName:='';
   p:=El.Parent;
   repeat
+    if p=nil then
+      RaiseNotYetImplemented(20220320165553,El);
     if (p is TPasDeclarations) or (p is TPasMembersType) then
       begin
       if CurName='' then
@@ -12563,6 +12565,7 @@ procedure TPasResolver.AddProcedureType(El: TPasProcedureType;
   TypeParams: TFPList);
 var
   Scope: TPasProcTypeScope;
+  C: TClass;
 begin
   if El.Name<>'' then
     begin
@@ -12602,6 +12605,11 @@ begin
     else
       begin
       // anonymous procedure type, e.g. "var p: procedure;"
+      C:=El.Parent.ClassType;
+      if C.InheritsFrom(TPasVariable) then
+        // ok
+      else
+        RaiseMsg(20220320165827,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
       DeanonymizeType(El);
       end;
     end;
@@ -21244,6 +21252,7 @@ begin
       RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
     else
       RaiseNotYetImplemented(20160922163544,El);
+
     Result:=El;
   finally
     if Result=nil then

packages/fcl-passrc/src/pparser.pp

@@ -2330,11 +2330,13 @@ begin
     ok:=true;
   finally
     if not ok then
+      begin
       if Result<>nil then
         begin
         Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
         Result:=nil;
         end;
+      end;
   end;
 end;
 
@@ -2358,27 +2360,36 @@ end;
 function TPasParser.ParseVarType(Parent : TPasElement = Nil): TPasType;
 var
   NamePos: TPasSourcePos;
+  ok: Boolean;
 begin
-  NextToken;
-  case CurToken of
-    tkProcedure:
-      begin
-        Result := TPasProcedureType(CreateElement(TPasProcedureType, '', Parent));
-        ParseProcedureOrFunction(Result, TPasProcedureType(Result), ptProcedure, True);
-        if CurToken = tkSemicolon then
-          UngetToken;        // Unget semicolon
-      end;
-    tkFunction:
-      begin
-        Result := CreateFunctionType('', 'Result', Parent, False, CurSourcePos);
-        ParseProcedureOrFunction(Result, TPasFunctionType(Result), ptFunction, True);
-        if CurToken = tkSemicolon then
-          UngetToken;        // Unget semicolon
-      end;
-  else
-    NamePos:=CurSourcePos;
-    UngetToken;
-    Result := ParseType(Parent,NamePos);
+  Result:=nil;
+  ok:=false;
+  try
+    NextToken;
+    case CurToken of
+      tkProcedure:
+        begin
+          Result := TPasProcedureType(CreateElement(TPasProcedureType, '', Parent));
+          ParseProcedureOrFunction(Result, TPasProcedureType(Result), ptProcedure, True);
+          if CurToken = tkSemicolon then
+            UngetToken;        // Unget semicolon
+        end;
+      tkFunction:
+        begin
+          Result := CreateFunctionType('', 'Result', Parent, False, CurSourcePos);
+          ParseProcedureOrFunction(Result, TPasFunctionType(Result), ptFunction, True);
+          if CurToken = tkSemicolon then
+            UngetToken;        // Unget semicolon
+        end;
+    else
+      NamePos:=CurSourcePos;
+      UngetToken;
+      Result := ParseType(Parent,NamePos);
+    end;
+    ok:=true;
+  finally
+    if (not ok) and (Result<>nil) then
+      Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
   end;
 end;
 

packages/fcl-passrc/tests/tcresolver.pas

@@ -891,7 +891,7 @@ type
     Procedure TestProcType_PassProcToUntyped;
 
     // anonymous procedure type
-    Procedure TestProcTypeAnonymous_FunctionFunctionFail; // ToDo
+    Procedure TestProcTypeAnonymous_FunctionFunctionFail;
 
     // pointer
     Procedure TestPointer;
@@ -16526,15 +16526,13 @@ end;
 
 procedure TTestResolver.TestProcTypeAnonymous_FunctionFunctionFail;
 begin
-  exit;
-
   StartProgram(false);
   Add([
   'var',
   '  f: function:function:longint;',
   'begin']);
-  CheckParserException('Expected "Identifier or file"',
-    nParserExpectTokenError);
+  CheckResolverException('Cannot nest anonymous functional type',
+    nCannotNestAnonymousX);
 end;
 
 procedure TTestResolver.TestPointer;