mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-08 12:07:16 +02:00
* ensure that internal method names (namely operator overloads and class con-/destructors) result in different mangled names from ordinary methods even if they should be converted to lowercase (which happens for section names)
+ added tests git-svn-id: trunk@47110 -
This commit is contained in:
parent
7dff106d14
commit
eb7158d250
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -13354,6 +13354,8 @@ tests/tbs/tb0676.pp svneol=native#text/pascal
|
|||||||
tests/tbs/tb0676a.pp svneol=native#text/plain
|
tests/tbs/tb0676a.pp svneol=native#text/plain
|
||||||
tests/tbs/tb0677.pp svneol=native#text/pascal
|
tests/tbs/tb0677.pp svneol=native#text/pascal
|
||||||
tests/tbs/tb0678.pp svneol=native#text/pascal
|
tests/tbs/tb0678.pp svneol=native#text/pascal
|
||||||
|
tests/tbs/tb0679.pp svneol=native#text/pascal
|
||||||
|
tests/tbs/tb0680.pp svneol=native#text/pascal
|
||||||
tests/tbs/ub0060.pp svneol=native#text/plain
|
tests/tbs/ub0060.pp svneol=native#text/plain
|
||||||
tests/tbs/ub0069.pp svneol=native#text/plain
|
tests/tbs/ub0069.pp svneol=native#text/plain
|
||||||
tests/tbs/ub0119.pp svneol=native#text/plain
|
tests/tbs/ub0119.pp svneol=native#text/plain
|
||||||
|
@ -6795,10 +6795,17 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function tprocdef.defaultmangledname: TSymStr;
|
function tprocdef.defaultmangledname: TSymStr;
|
||||||
|
var
|
||||||
|
n : TSymStr;
|
||||||
begin
|
begin
|
||||||
|
n:=procsym.name;
|
||||||
|
{ make sure that the mangled names of these overloadable methods types is
|
||||||
|
unique even if it's made lowercase (e.g. for section names) }
|
||||||
|
if proctypeoption in [potype_operator,potype_class_constructor,potype_class_destructor] then
|
||||||
|
n:='$'+n;
|
||||||
{ we need to use the symtable where the procsym is inserted,
|
{ we need to use the symtable where the procsym is inserted,
|
||||||
because that is visible to the world }
|
because that is visible to the world }
|
||||||
defaultmangledname:=make_mangledname('',procsym.owner,procsym.name);
|
defaultmangledname:=make_mangledname('',procsym.owner,n);
|
||||||
defaultmangledname:=defaultmangledname+mangledprocparanames(Length(defaultmangledname))
|
defaultmangledname:=defaultmangledname+mangledprocparanames(Length(defaultmangledname))
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
28
tests/tbs/tb0679.pp
Normal file
28
tests/tbs/tb0679.pp
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
{ %NORUN }
|
||||||
|
|
||||||
|
program tb0679;
|
||||||
|
|
||||||
|
{$mode objfpc}
|
||||||
|
|
||||||
|
type
|
||||||
|
TA = class
|
||||||
|
public
|
||||||
|
class destructor Destroy;
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class destructor TA.Destroy;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TA.Destroy;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
A: TA;
|
||||||
|
begin
|
||||||
|
A := TA.Create;
|
||||||
|
A.Free;
|
||||||
|
end.
|
26
tests/tbs/tb0680.pp
Normal file
26
tests/tbs/tb0680.pp
Normal file
@ -0,0 +1,26 @@
|
|||||||
|
{ %NORUN }
|
||||||
|
|
||||||
|
program tb0680;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
{$modeswitch advancedrecords}
|
||||||
|
|
||||||
|
type
|
||||||
|
TTest = record
|
||||||
|
class operator + (aLeft, aRight: TTest): TTest;
|
||||||
|
function Plus(aLeft, aRight: TTest): TTest;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class operator TTest.+(aLeft, aRight: TTest): TTest;
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TTest.Plus(aLeft, aRight: TTest): TTest;
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user