* fix #39869: correctly check whether the recorded token stream still needs to be parsed (the replay depth of the scanner needs to be *larger* than what it was before starting the playback)

+ added test

(cherry picked from commit 61debb1559eb3fe499316c673a7bd8a265cd58b7)

compiler/pgenutil.pas

@@ -1099,10 +1099,10 @@ uses
                   { Build VMT indexes for classes and read hint directives }
                   objectdef:
                     begin
-                      if replaydepth>current_scanner.replay_stack_depth then
+                      if replaydepth<current_scanner.replay_stack_depth then
                         begin
                           try_consume_hintdirective(srsym.symoptions,srsym.deprecatedmsg);
-                          if replaydepth>current_scanner.replay_stack_depth then
+                          if replaydepth<current_scanner.replay_stack_depth then
                             consume(_SEMICOLON);
                         end;
 
@@ -1114,24 +1114,24 @@ uses
                   procvardef:
                     begin
                       hintsprocessed:=false;
-                      if replaydepth>current_scanner.replay_stack_depth then
+                      if replaydepth<current_scanner.replay_stack_depth then
                         begin
                           if not check_proc_directive(true) then
                             begin
                               hintsprocessed:=try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg);
-                              if replaydepth>current_scanner.replay_stack_depth then
+                              if replaydepth<current_scanner.replay_stack_depth then
                                 consume(_SEMICOLON);
                             end
                           else
                             hintsprocessed:=true;
                         end;
-                      if replaydepth>current_scanner.replay_stack_depth then
+                      if replaydepth<current_scanner.replay_stack_depth then
                         parse_var_proc_directives(ttypesym(srsym));
                       handle_calling_convention(tprocvardef(result),hcc_default_actions_intf);
-                      if not hintsprocessed and (replaydepth>current_scanner.replay_stack_depth) then
+                      if not hintsprocessed and (replaydepth<current_scanner.replay_stack_depth) then
                         begin
                           try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg);
-                          if replaydepth>current_scanner.replay_stack_depth then
+                          if replaydepth<current_scanner.replay_stack_depth then
                             consume(_SEMICOLON);
                         end;
                     end;
@@ -1157,9 +1157,9 @@ uses
                     end;
                   else
                     { parse hint directives for records and arrays }
-                    if replaydepth>current_scanner.replay_stack_depth then begin
+                    if replaydepth<current_scanner.replay_stack_depth then begin
                       try_consume_hintdirective(srsym.symoptions,srsym.deprecatedmsg);
-                      if replaydepth>current_scanner.replay_stack_depth then
+                      if replaydepth<current_scanner.replay_stack_depth then
                         consume(_SEMICOLON);
                     end;
                 end;

tests/webtbs/tw39869.pp

@@ -0,0 +1,67 @@
+{ %NORUN }
+
+program tw39869;
+
+{$mode objfpc}{$H+}
+
+uses
+  TypInfo, SysUtils;
+
+{$DEFINE _WORKING}
+{$DEFINE NOTWORKING}
+
+type
+{$IFDEF NOTWORKING}
+  generic TCallProcStdCall<T> = procedure(aArg1:T;aArg2:Integer;aArg3:Integer) of object;stdcall;
+  TGenericCallProcIntegerStdCall = specialize TCallProcStdCall<Integer>;
+{$ENDIF}
+
+  { TTest }
+  generic TGenericTest<T> = class
+{$IFDEF WORKING}
+  type
+    TCallProcStdCall = procedure(aArg1:T;aArg2:Integer;aArg3:Integer) of object;stdcall;
+{$ENDIF}
+  public
+    procedure StdCalling(aArg1:T;aArg2:Integer;aArg3:Integer);stdcall;
+  end;
+
+  TIntTest = specialize TGenericTest<Integer>;
+
+{ TTest }
+procedure TGenericTest.StdCalling(aArg1:T;aArg2:Integer;aArg3:Integer); stdcall;
+begin
+  WriteLn('Self=0x'+IntToHex(IntPtr(self),SizeOf(self)*2)+
+          ' Arg1='+IntToStr(PtrInt(aArg1))+
+          ' Arg2='+IntToStr(aArg2)+
+          ' Arg3='+IntToStr(aArg3));
+end;
+
+var
+  obj       : TIntTest;
+{$IFDEF NOTWORKING}
+  stdCallPtr: TGenericCallProcIntegerStdCall;
+{$ENDIF}
+{$IFDEF WORKING}
+  stdCallPtr: specialize TGenericTest<integer>.TCallProcStdCall;
+{$ENDIF}
+begin
+  obj := TIntTest.Create;
+  try
+    //project1.lpr(51,23) Error:
+    //Incompatible types:
+    //got      "<procedure variable type of procedure(LongInt;LongInt;LongInt) of object;StdCall>"
+    //expected "<procedure variable type of procedure(LongInt;LongInt;LongInt) of object;Register>"
+    stdCallPtr := @obj.StdCalling;
+
+    obj.StdCalling(1,2,3);
+
+    //call is made with wrong calling convention
+    stdCallPtr(1,2,3);
+
+    //readln;
+  finally
+    obj.Free;
+  end;
+end.
+