mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 02:19:22 +01:00 
			
		
		
		
	* class helpers: fix calling virtual methods of the extended type using inherited
git-svn-id: trunk@37060 -
This commit is contained in:
		
							parent
							
								
									597cf52a3a
								
							
						
					
					
						commit
						6acba684d4
					
				
							
								
								
									
										1
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										1
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							@ -12466,6 +12466,7 @@ tests/test/tchlp55.pp svneol=native#text/pascal
 | 
			
		||||
tests/test/tchlp56.pp svneol=native#text/pascal
 | 
			
		||||
tests/test/tchlp57.pp svneol=native#text/pascal
 | 
			
		||||
tests/test/tchlp58.pp svneol=native#text/pascal
 | 
			
		||||
tests/test/tchlp59.pp svneol=native#text/pascal
 | 
			
		||||
tests/test/tchlp6.pp svneol=native#text/pascal
 | 
			
		||||
tests/test/tchlp7.pp svneol=native#text/pascal
 | 
			
		||||
tests/test/tchlp8.pp svneol=native#text/pascal
 | 
			
		||||
 | 
			
		||||
@ -3355,6 +3355,7 @@ implementation
 | 
			
		||||
         filepos    : tfileposinfo;
 | 
			
		||||
         callflags  : tcallnodeflags;
 | 
			
		||||
         idstr      : tidstring;
 | 
			
		||||
         useself,
 | 
			
		||||
         dopostfix,
 | 
			
		||||
         again,
 | 
			
		||||
         updatefpos,
 | 
			
		||||
@ -3513,6 +3514,7 @@ implementation
 | 
			
		||||
                       case srsym.typ of
 | 
			
		||||
                         procsym:
 | 
			
		||||
                           begin
 | 
			
		||||
                             useself:=false;
 | 
			
		||||
                             if is_objectpascal_helper(current_structdef) then
 | 
			
		||||
                               begin
 | 
			
		||||
                                 { for a helper load the procdef either from the
 | 
			
		||||
@ -3526,18 +3528,31 @@ implementation
 | 
			
		||||
                                       assigned(tobjectdef(current_structdef).childof) then
 | 
			
		||||
                                     hdef:=tobjectdef(current_structdef).childof
 | 
			
		||||
                                   else
 | 
			
		||||
                                     hdef:=tobjectdef(srsym.Owner.defowner).extendeddef
 | 
			
		||||
                                     begin
 | 
			
		||||
                                       hdef:=tobjectdef(srsym.Owner.defowner).extendeddef;
 | 
			
		||||
                                       useself:=true;
 | 
			
		||||
                                     end
 | 
			
		||||
                                 else
 | 
			
		||||
                                   hdef:=tdef(srsym.Owner.defowner);
 | 
			
		||||
                                   begin
 | 
			
		||||
                                     hdef:=tdef(srsym.Owner.defowner);
 | 
			
		||||
                                     useself:=true;
 | 
			
		||||
                                   end;
 | 
			
		||||
                               end
 | 
			
		||||
                             else
 | 
			
		||||
                               hdef:=hclassdef;
 | 
			
		||||
                             if (po_classmethod in current_procinfo.procdef.procoptions) or
 | 
			
		||||
                                (po_staticmethod in current_procinfo.procdef.procoptions) then
 | 
			
		||||
                               hdef:=cclassrefdef.create(hdef);
 | 
			
		||||
                             p1:=ctypenode.create(hdef);
 | 
			
		||||
                             { we need to allow helpers here }
 | 
			
		||||
                             ttypenode(p1).helperallowed:=true;
 | 
			
		||||
                             if useself then
 | 
			
		||||
                               begin
 | 
			
		||||
                                 p1:=ctypeconvnode.create_internal(load_self_node,hdef);
 | 
			
		||||
                               end
 | 
			
		||||
                             else
 | 
			
		||||
                               begin
 | 
			
		||||
                                 p1:=ctypenode.create(hdef);
 | 
			
		||||
                                 { we need to allow helpers here }
 | 
			
		||||
                                 ttypenode(p1).helperallowed:=true;
 | 
			
		||||
                               end;
 | 
			
		||||
                           end;
 | 
			
		||||
                         propertysym:
 | 
			
		||||
                           ;
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										40
									
								
								tests/test/tchlp59.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										40
									
								
								tests/test/tchlp59.pp
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,40 @@
 | 
			
		||||
program tchlp42;
 | 
			
		||||
 | 
			
		||||
{$mode objfpc}
 | 
			
		||||
 | 
			
		||||
type
 | 
			
		||||
  TTest = class
 | 
			
		||||
    function Test: LongInt; virtual;
 | 
			
		||||
  end;
 | 
			
		||||
 | 
			
		||||
  TTestSub = class(TTest)
 | 
			
		||||
    function Test: LongInt; override;
 | 
			
		||||
  end;
 | 
			
		||||
 | 
			
		||||
  TTestHelper = class helper for TTest
 | 
			
		||||
    function Test: LongInt;
 | 
			
		||||
  end;
 | 
			
		||||
 | 
			
		||||
function TTestHelper.Test: LongInt;
 | 
			
		||||
begin
 | 
			
		||||
  Result := inherited Test * 10;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function TTestSub.Test: LongInt;
 | 
			
		||||
begin
 | 
			
		||||
  Result := 2;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function TTest.Test: LongInt;
 | 
			
		||||
begin
 | 
			
		||||
  Result := 1;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  t: TTest;
 | 
			
		||||
begin
 | 
			
		||||
  t := TTestSub.Create;
 | 
			
		||||
  if t.Test <> 20 then
 | 
			
		||||
    Halt(1);
 | 
			
		||||
  Writeln('ok');
 | 
			
		||||
end.
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user