From c6874df5c8ffcb6ad97096e63b63afe12e86b08d Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Thu, 16 Dec 2021 22:27:18 +0100
Subject: [PATCH] * better error recovery, resolves #39485
---
compiler/pdecobj.pas | 25 ++++++++++++++++++++-----
tests/tbf/tw39485.pp | 20 ++++++++++++++++++++
2 files changed, 40 insertions(+), 5 deletions(-)
create mode 100644 tests/tbf/tw39485.pp
diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
index b490cd18f3..fd08b0e40b 100644
--- a/compiler/pdecobj.pas
+++ b/compiler/pdecobj.pas
@@ -165,6 +165,8 @@ implementation
procedure struct_property_dec(is_classproperty:boolean;var rtti_attrs_def: trtti_attribute_list);
var
p : tpropertysym;
+ _deprecatedmsg: pshortstring;
+ _symoptions: tsymoptions;
begin
{ check for a class, record or helper }
if not((is_class_or_interface_or_dispinterface(current_structdef) or is_record(current_structdef) or
@@ -214,12 +216,25 @@ implementation
Message(parser_e_enumerator_identifier_required);
consume(_SEMICOLON);
end;
- trtti_attribute_list.bind(rtti_attrs_def,p.rtti_attribute_list);
+ { in case of a previous error, p might not be assigned }
+ if assigned(p) then
+ begin
+ trtti_attribute_list.bind(rtti_attrs_def,p.rtti_attribute_list);
- { hint directives, these can be separated by semicolons here,
- that needs to be handled here with a loop (PFV) }
- while try_consume_hintdirective(p.symoptions,p.deprecatedmsg) do
- Consume(_SEMICOLON);
+ { hint directives, these can be separated by semicolons here,
+ that needs to be handled here with a loop (PFV) }
+ while try_consume_hintdirective(p.symoptions,p.deprecatedmsg) do
+ Consume(_SEMICOLON);
+ end
+ else
+ begin
+ { recover from error so we can continue to parse }
+
+ { hint directives, these can be separated by semicolons here,
+ that needs to be handled here with a loop (PFV) }
+ while try_consume_hintdirective(_symoptions,_deprecatedmsg) do
+ Consume(_SEMICOLON);
+ end;
end;
diff --git a/tests/tbf/tw39485.pp b/tests/tbf/tw39485.pp
new file mode 100644
index 0000000000..ef52cff418
--- /dev/null
+++ b/tests/tbf/tw39485.pp
@@ -0,0 +1,20 @@
+{ %fail }
+program Project1;
+{$mode objfpc}{$H+}{$Interfaces CORBA}
+
+type
+ ITest = interface
+ end;
+
+ TBar = class;
+
+ TFoo = class(TObject, ITest)
+ Fa: TBar;
+ property a: TBar read Fa implements ITest;
+ end;
+
+ TBar = class(TObject, ITest)
+ end;
+
+begin
+end.