* better fix for #39634 which avoids breaking existing code

compiler/defcmp.pas

@@ -1584,60 +1584,79 @@ implementation
                           eq:=te_equal
                        end
                      else
-                      { same types }
-                      if equal_defs(tpointerdef(def_from).pointeddef,tpointerdef(def_to).pointeddef) then
                        begin
-                         eq:=te_equal
-                       end
-                     else
-                      { child class pointer can be assigned to anchestor pointers }
-                      if (
-                          (tpointerdef(def_from).pointeddef.typ=objectdef) and
-                          (tpointerdef(def_to).pointeddef.typ=objectdef) and
-                          def_is_related(tobjectdef(tpointerdef(def_from).pointeddef),
-                            tobjectdef(tpointerdef(def_to).pointeddef))
-                         ) then
-                       begin
-                         doconv:=tc_equal;
-                         eq:=te_convert_l1;
-                       end
-                     else
-                      { all pointers can be assigned to void-pointer }
-                      if is_void(tpointerdef(def_to).pointeddef) then
-                       begin
-                         doconv:=tc_equal;
-                         { give pwidechar,pchar a penalty so it prefers
-                           conversion to ansistring }
-                         if is_pchar(def_from) or
-                            is_pwidechar(def_from) then
-                           eq:=te_convert_l2
+                         { avoid crash/stack overflow on recursive pointer definitions, see tests/webtbf/tw39634.pp }
+                         hd1:=tabstractpointerdef(def_from).pointeddef;
+                         hd2:=tabstractpointerdef(def_to).pointeddef;
+                         while assigned(hd1) and (hd1.typ=pointerdef) and
+                           assigned(hd2) and (hd2.typ=pointerdef) do
+                           begin
+                             if hd1=hd2 then
+                               break;
+                             if (hd1=def_from) and (hd2=def_to) then
+                               begin
+                                 eq:=te_incompatible;
+                                 break;
+                               end;
+                             hd1:=tabstractpointerdef(hd1).pointeddef;
+                             hd2:=tabstractpointerdef(hd2).pointeddef;
+                           end;
+
+                         { same types }
+                         if not((hd1=def_from) and (hd2=def_to)) and equal_defs(tpointerdef(def_from).pointeddef,tpointerdef(def_to).pointeddef) then
+                           begin
+                             eq:=te_equal
+                           end
                          else
-                           eq:=te_convert_l1;
-                       end
-                     else
-                      { all pointers can be assigned from void-pointer }
-                      if is_void(tpointerdef(def_from).pointeddef) or
-                      { all pointers can be assigned from void-pointer or formaldef pointer, check
-                        tw3777.pp if you change this }
-                        (tpointerdef(def_from).pointeddef.typ=formaldef) then
-                       begin
-                         doconv:=tc_equal;
-                         { give pwidechar a penalty so it prefers
-                           conversion to pchar }
-                         if is_pwidechar(def_to) then
-                           eq:=te_convert_l2
+                          { child class pointer can be assigned to anchestor pointers }
+                          if (
+                              (tpointerdef(def_from).pointeddef.typ=objectdef) and
+                              (tpointerdef(def_to).pointeddef.typ=objectdef) and
+                              def_is_related(tobjectdef(tpointerdef(def_from).pointeddef),
+                                tobjectdef(tpointerdef(def_to).pointeddef))
+                             ) then
+                           begin
+                             doconv:=tc_equal;
+                             eq:=te_convert_l1;
+                           end
                          else
-                           eq:=te_convert_l1;
-                       end
-                     { id = generic class instance. metaclasses are also
-                       class instances themselves.  }
-                     else if ((def_from=objc_idtype) and
-                              (def_to=objc_metaclasstype)) or
-                             ((def_to=objc_idtype) and
-                              (def_from=objc_metaclasstype)) then
-                       begin
-                         doconv:=tc_equal;
-                         eq:=te_convert_l2;
+                          { all pointers can be assigned to void-pointer }
+                          if is_void(tpointerdef(def_to).pointeddef) then
+                           begin
+                             doconv:=tc_equal;
+                             { give pwidechar,pchar a penalty so it prefers
+                               conversion to ansistring }
+                             if is_pchar(def_from) or
+                                is_pwidechar(def_from) then
+                               eq:=te_convert_l2
+                             else
+                               eq:=te_convert_l1;
+                           end
+                         else
+                          { all pointers can be assigned from void-pointer }
+                          if is_void(tpointerdef(def_from).pointeddef) or
+                          { all pointers can be assigned from void-pointer or formaldef pointer, check
+                            tw3777.pp if you change this }
+                            (tpointerdef(def_from).pointeddef.typ=formaldef) then
+                           begin
+                             doconv:=tc_equal;
+                             { give pwidechar a penalty so it prefers
+                               conversion to pchar }
+                             if is_pwidechar(def_to) then
+                               eq:=te_convert_l2
+                             else
+                               eq:=te_convert_l1;
+                           end
+                         { id = generic class instance. metaclasses are also
+                           class instances themselves.  }
+                         else if ((def_from=objc_idtype) and
+                                  (def_to=objc_metaclasstype)) or
+                                 ((def_to=objc_idtype) and
+                                  (def_from=objc_metaclasstype)) then
+                           begin
+                             doconv:=tc_equal;
+                             eq:=te_convert_l2;
+                           end;
                        end;
                    end;
                  procvardef :

compiler/msg/errore.msg

@@ -445,7 +445,7 @@ scan_e_unexpected_endif=02108_E_$ENDIF directive found without a matching $IF(N)
 #
 # Parser
 #
-# 03365 is the last used one
+# 03364 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1642,13 +1642,6 @@ parser_e_syscall_format_not_support=03364_E_Syntax of syscall directive not supp
 % On a certain target, not all syntax variants of the syscall directive make sense and thus those making
 % no sense are not supported
 % Declarations like \var{var i: Integer absolute i;} are not allowed
-parser_e_cyclic_pointertypes_are_not_allowed=03365_E_Cyclic definitions of pointers are not allowed
-% Pointers may not be defined cyclic like:
-% \begin{verbatim}
-% type
-%  tp1 = ^tp2;
-%  tp2 = ^tp1;
-% \end{verbatim}
 %
 % \end{description}
 %

compiler/msgidx.inc

@@ -478,7 +478,6 @@ const
   parser_e_section_directive_not_allowed_for_target=03362;
   parser_e_absolute_sym_cannot_reference_itself=03363;
   parser_e_syscall_format_not_support=03364;
-  parser_e_cyclic_pointertypes_are_not_allowed=03365;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -1153,9 +1152,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 89674;
+  MsgTxtSize = 89619;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,109,366,131,99,63,148,37,223,70,
+    28,109,365,131,99,63,148,37,223,70,
     65,20,30,1,1,1,1,1,1,1
   );

compiler/ptype.pas

@@ -213,16 +213,6 @@ implementation
                               fileinfo:=srsym.fileinfo;
                             MessagePos(fileinfo,parser_e_no_generics_as_types);
                           end;
-                        hpd:=tabstractpointerdef(def).pointeddef;
-                        while assigned(hpd) and (hpd.typ=pointerdef) do
-                          begin
-                            if def=hpd then
-                              begin
-                                MessagePos(def.typesym.fileinfo,parser_e_cyclic_pointertypes_are_not_allowed);
-                                break;
-                              end;
-                            hpd:=tabstractpointerdef(hpd).pointeddef;
-                          end;
                       end
                      else
                       begin