mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 12:39:25 +02:00
* don't give warning about constructing instance with abstract methods
for self.create calls + tests git-svn-id: trunk@5810 -
This commit is contained in:
parent
4b88079c41
commit
2ddeca21e6
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -5670,6 +5670,7 @@ tests/tbf/tb0189.pp svneol=native#text/plain
|
||||
tests/tbf/tb0190.pp svneol=native#text/plain
|
||||
tests/tbf/tb0191.pp svneol=native#text/plain
|
||||
tests/tbf/tb0192.pp svneol=native#text/plain
|
||||
tests/tbf/tb0193.pp svneol=native#text/plain
|
||||
tests/tbf/ub0115.pp svneol=native#text/plain
|
||||
tests/tbf/ub0149.pp svneol=native#text/plain
|
||||
tests/tbf/ub0158a.pp svneol=native#text/plain
|
||||
@ -6188,6 +6189,7 @@ tests/tbs/tb0518.pp svneol=native#text/plain
|
||||
tests/tbs/tb0519.pp svneol=native#text/plain
|
||||
tests/tbs/tb0520.pp svneol=native#text/plain
|
||||
tests/tbs/tb0521.pp svneol=native#text/plain
|
||||
tests/tbs/tb0522.pp svneol=native#text/plain
|
||||
tests/tbs/ub0060.pp svneol=native#text/plain
|
||||
tests/tbs/ub0069.pp svneol=native#text/plain
|
||||
tests/tbs/ub0119.pp svneol=native#text/plain
|
||||
|
@ -1391,7 +1391,8 @@ implementation
|
||||
{ also, this checking can only be done if the constructor is directly
|
||||
called, indirect constructor calls cannot be checked.
|
||||
}
|
||||
if assigned(methodpointer) then
|
||||
if assigned(methodpointer) and
|
||||
not (nf_is_self in methodpointer.flags) then
|
||||
begin
|
||||
if (methodpointer.resultdef.typ = objectdef) then
|
||||
objectdf:=tobjectdef(methodpointer.resultdef)
|
||||
|
38
tests/tbf/tb0193.pp
Normal file
38
tests/tbf/tb0193.pp
Normal file
@ -0,0 +1,38 @@
|
||||
{ %opt -Sew }
|
||||
{ %fail }
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif fpc}
|
||||
|
||||
type
|
||||
tc = class
|
||||
constructor create1;
|
||||
constructor create2;
|
||||
procedure t; virtual; abstract;
|
||||
end;
|
||||
|
||||
td = class(tc)
|
||||
procedure t; override;
|
||||
end;
|
||||
|
||||
constructor tc.create1;
|
||||
begin
|
||||
inherited create;
|
||||
end;
|
||||
|
||||
constructor tc.create2;
|
||||
begin
|
||||
self.create1;
|
||||
end;
|
||||
|
||||
procedure td.t;
|
||||
begin
|
||||
end;
|
||||
|
||||
var
|
||||
d: tc;
|
||||
begin
|
||||
d := tc.create2;
|
||||
d.free;
|
||||
end.
|
37
tests/tbs/tb0522.pp
Normal file
37
tests/tbs/tb0522.pp
Normal file
@ -0,0 +1,37 @@
|
||||
{ %opt=-Sew }
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif fpc}
|
||||
|
||||
type
|
||||
tc = class
|
||||
constructor create1;
|
||||
constructor create2;
|
||||
procedure t; virtual; abstract;
|
||||
end;
|
||||
|
||||
td = class(tc)
|
||||
procedure t; override;
|
||||
end;
|
||||
|
||||
constructor tc.create1;
|
||||
begin
|
||||
inherited create;
|
||||
end;
|
||||
|
||||
constructor tc.create2;
|
||||
begin
|
||||
self.create1;
|
||||
end;
|
||||
|
||||
procedure td.t;
|
||||
begin
|
||||
end;
|
||||
|
||||
var
|
||||
d: td;
|
||||
begin
|
||||
d := td.create2;
|
||||
d.free;
|
||||
end.
|
Loading…
Reference in New Issue
Block a user