Skip to content
GitLab
    • Why GitLab
    • Pricing
    • Contact Sales
    • Explore
  • Why GitLab
  • Pricing
  • Contact Sales
  • Explore
  • Sign in
  • Get free trial
  • FPC
  • FPC FPC
  • FPC Source FPC Source
  • Issues
  • #40316

Anonymous functions: Memory is apparently corrupted, when the code is between "BEGIN" and "END." Block

This program is made to test a concept to capture variables by value (not by reference), which was demonstrated by embarcadero and Boian Mitov in some tutorial videos on Youtube.

The concept is: The outer anonymous function captures a value, and the inner nested anonymous function uses this value and can use it again at a later time. https://youtu.be/HDhmUjzUNyQ?t=1922

{$ifdef FPC}
{$mode objfpc}{$H+}
{$modeswitch functionreferences}
{$modeswitch anonymousfunctions}
{$endif}
//This program should ALWAYS print "1".
//The program compiles also in Delphi and has not this Bug in Delphi.

//When the Symbol "TEST" is defined, the program outputs a random number.
//When the Symbol "TEST" is undefined, the program outputs "1", which is correct.

//Probably in the first case the memory is somehow invalid.
//Consequently I would get access violation when I used pointers or strings
//   instead of integer type for the test-variable "X" because this would give random pointers.

// Compiler version used: (but older versions have same problem)
//Free Pascal Compiler version 3.3.1-12746-g9bfb45dc05 [2023/06/10] for x86_64
//Target OS: Win64 for x64

type  Tpr = reference to procedure;
var   p_inner: Tpr;
      X,x2: integer;

{$define TEST}

{$ifndef TEST}
procedure main;
{$endif}
begin
   x2:=0;
   X := 1;
{$ifdef FPC}
   procedure(s:integer)
   begin
     p_inner := procedure
     begin
        x2 := s;
        Writeln(s);
     end;
   end(X);
{$else}  //This compiles in Delphi and works in both cases
   const p_outer = procedure(s:integer)
   begin
     p_inner := procedure
     begin
       x2 := s;
       Writeln(s);
     end;
   end;
   p_outer(X);
{$endif}

   X := 0;

   Writeln('p_outer was called, now calling p_inner');
   p_inner();  // This SHOULD print "1".
   if x2=1 then
     Writeln('"1" is the correct result, Success!')
   else
     Writeln('Result must be "1", Failure!');
  readln;

{$ifndef TEST}
end;

begin
  main;
{$endif}
end.

Edited Jun 13, 2023 by Peter Heckert
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking