mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 06:59:33 +01:00 
			
		
		
		
	+ 312 problem with local proc in methods and ForEach
This commit is contained in:
		
							parent
							
								
									e99f82c8fa
								
							
						
					
					
						commit
						311a357239
					
				
							
								
								
									
										142
									
								
								bugs/bug0312.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										142
									
								
								bugs/bug0312.pp
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,142 @@
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
uses
 | 
			
		||||
  objects;
 | 
			
		||||
 | 
			
		||||
type
 | 
			
		||||
{$ifndef FPC}
 | 
			
		||||
  sw_integer = integer;
 | 
			
		||||
{$endif not FPC}
 | 
			
		||||
 | 
			
		||||
  PMYObj = ^TMyObj;
 | 
			
		||||
 | 
			
		||||
  TMyObj = Object(TObject)
 | 
			
		||||
    x : longint;
 | 
			
		||||
    Constructor Init(ax : longint);
 | 
			
		||||
    procedure display;virtual;
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  PMYObj2 = ^TMyObj2;
 | 
			
		||||
 | 
			
		||||
  TMyObj2 = Object(TMyObj)
 | 
			
		||||
    y : longint;
 | 
			
		||||
    Constructor Init(ax,ay : longint);
 | 
			
		||||
    procedure display;virtual;
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  PMyCollection = ^TMyCollection;
 | 
			
		||||
 | 
			
		||||
  TMyCollection = Object(TCollection)
 | 
			
		||||
    function At(I : sw_integer) : PMyObj;
 | 
			
		||||
    procedure DummyThatShouldNotBeCalled;virtual;
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  { TMy is also a TCollection so that
 | 
			
		||||
    ShowMy and DummyThatShouldNotBeCalled are at same position in VMT }
 | 
			
		||||
  TMy = Object(TCollection)
 | 
			
		||||
    Col : PMyCollection;
 | 
			
		||||
    MyObj : PMyObj;
 | 
			
		||||
    ShowMyCalled : boolean;
 | 
			
		||||
    constructor Init;
 | 
			
		||||
    destructor Done;virtual;
 | 
			
		||||
    procedure ShowAll;
 | 
			
		||||
    procedure AddMyObj(x : longint);
 | 
			
		||||
    procedure AddMyObj2(x,y : longint);
 | 
			
		||||
    procedure ShowMy;virtual;
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  Constructor TMyObj.Init(ax : longint);
 | 
			
		||||
    begin
 | 
			
		||||
      Inherited Init;
 | 
			
		||||
      x:=ax;
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  Procedure TMyObj.Display;
 | 
			
		||||
    begin
 | 
			
		||||
      Writeln('x = ',x);
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  Constructor TMyObj2.Init(ax,ay : longint);
 | 
			
		||||
    begin
 | 
			
		||||
      Inherited Init(ax);
 | 
			
		||||
      y:=ay;
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  Procedure TMyObj2.Display;
 | 
			
		||||
    begin
 | 
			
		||||
      Writeln('x = ',x,' y = ',y);
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  Function TMyCollection.At(I : sw_integer) : PMyObj;
 | 
			
		||||
    begin
 | 
			
		||||
      At:=Inherited At(I);
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  Procedure TMyCollection.DummyThatShouldNotBeCalled;
 | 
			
		||||
    begin
 | 
			
		||||
      Writeln('This method should never be called');
 | 
			
		||||
      Abstract;
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  Constructor TMy.Init;
 | 
			
		||||
 | 
			
		||||
    begin
 | 
			
		||||
      New(Col,Init(5,5));
 | 
			
		||||
      MyObj:=nil;
 | 
			
		||||
      ShowMyCalled:=false;
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  Destructor TMy.Done;
 | 
			
		||||
    begin
 | 
			
		||||
      Dispose(Col,Done);
 | 
			
		||||
      Inherited Done;
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  Procedure TMy.ShowAll;
 | 
			
		||||
 | 
			
		||||
      procedure ShowIt(P : pointer);{$ifdef TP}far;{$endif}
 | 
			
		||||
        begin
 | 
			
		||||
          ShowMy;
 | 
			
		||||
          PMyObj(P)^.Display;
 | 
			
		||||
        end;
 | 
			
		||||
    begin
 | 
			
		||||
      Col^.ForEach(@ShowIt);
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  Procedure TMy.ShowMy;
 | 
			
		||||
    begin
 | 
			
		||||
      if assigned(MyObj) then
 | 
			
		||||
        MyObj^.Display;
 | 
			
		||||
      ShowMyCalled:=true;
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  Procedure TMy.AddMyObj(x : longint);
 | 
			
		||||
 | 
			
		||||
    begin
 | 
			
		||||
      MyObj:=New(PMyObj,Init(x));
 | 
			
		||||
      Col^.Insert(MyObj);
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
  Procedure TMy.AddMyObj2(x,y : longint);
 | 
			
		||||
    begin
 | 
			
		||||
      MyObj:=New(PMyObj2,Init(x,y));
 | 
			
		||||
      Col^.Insert(MyObj);
 | 
			
		||||
    end;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
   My : TMy;
 | 
			
		||||
begin
 | 
			
		||||
   My.Init;
 | 
			
		||||
   My.AddMyObj(5);
 | 
			
		||||
   My.AddMyObj2(4,3);
 | 
			
		||||
   My.AddMyObj(43);
 | 
			
		||||
   { MyObj field is now a PMyObj with value 43 }
 | 
			
		||||
   My.ShowAll;
 | 
			
		||||
   If not My.ShowMyCalled then
 | 
			
		||||
     begin
 | 
			
		||||
       Writeln('ShowAll does not work correctly');
 | 
			
		||||
       Halt(1);
 | 
			
		||||
     end;
 | 
			
		||||
   My.Done;
 | 
			
		||||
 | 
			
		||||
end.
 | 
			
		||||
@ -401,3 +401,4 @@ bug0262.pp   problems with virtual and overloaded methods
 | 
			
		||||
bug0293.pp   no error with variable name = type name
 | 
			
		||||
bug0299.pp   passing Array[0..1] of char by value to proc leads to problems
 | 
			
		||||
bug0305.pp   Finally is not handled correctly after inputting 0
 | 
			
		||||
bug0312.pp   Again the problem of local procs inside methods
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user