mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-10 17:06:08 +02:00
+ Add similar checks for unit constants and procedures
git-svn-id: trunk@18928 -
This commit is contained in:
parent
0781ac1f82
commit
c8cf28e4ef
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -11757,6 +11757,7 @@ tests/webtbs/tw20035a.pp svneol=native#text/pascal
|
|||||||
tests/webtbs/tw20035b.pp svneol=native#text/pascal
|
tests/webtbs/tw20035b.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw2004.pp svneol=native#text/plain
|
tests/webtbs/tw2004.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw20093.pp svneol=native#text/pascal
|
tests/webtbs/tw20093.pp svneol=native#text/pascal
|
||||||
|
tests/webtbs/tw20093a.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw2028.pp svneol=native#text/plain
|
tests/webtbs/tw2028.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2030.pp svneol=native#text/plain
|
tests/webtbs/tw2030.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2031.pp svneol=native#text/plain
|
tests/webtbs/tw2031.pp svneol=native#text/plain
|
||||||
@ -12549,6 +12550,8 @@ tests/webtbs/ub1873.pp svneol=native#text/plain
|
|||||||
tests/webtbs/ub1883.pp svneol=native#text/plain
|
tests/webtbs/ub1883.pp svneol=native#text/plain
|
||||||
tests/webtbs/uvmt.pp svneol=native#text/pascal
|
tests/webtbs/uvmt.pp svneol=native#text/pascal
|
||||||
tests/webtbs/uvmt_a.pp svneol=native#text/pascal
|
tests/webtbs/uvmt_a.pp svneol=native#text/pascal
|
||||||
|
tests/webtbs/uvmta.pp svneol=native#text/pascal
|
||||||
|
tests/webtbs/uvmta_a.pp svneol=native#text/pascal
|
||||||
tests/webtbs/uw0555.pp svneol=native#text/plain
|
tests/webtbs/uw0555.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw0701c.pp svneol=native#text/plain
|
tests/webtbs/uw0701c.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw0701d.pp svneol=native#text/plain
|
tests/webtbs/uw0701d.pp svneol=native#text/plain
|
||||||
|
44
tests/webtbs/tw20093a.pp
Executable file
44
tests/webtbs/tw20093a.pp
Executable file
@ -0,0 +1,44 @@
|
|||||||
|
{ Test for bug report 20093
|
||||||
|
Reported 2011-08-29
|
||||||
|
a_tclass in unit uvmt
|
||||||
|
and tclass in unit uvmt_a
|
||||||
|
both generate the same symbol name for the VMT
|
||||||
|
}
|
||||||
|
|
||||||
|
{ Use same name as unit to test also
|
||||||
|
possible confusion there }
|
||||||
|
|
||||||
|
|
||||||
|
{$mode objfpc}
|
||||||
|
|
||||||
|
program vmt_uvmt;
|
||||||
|
|
||||||
|
uses
|
||||||
|
uvmta, uvmta_a;
|
||||||
|
|
||||||
|
var
|
||||||
|
t : longint;
|
||||||
|
begin
|
||||||
|
t:=6;
|
||||||
|
inc(t);
|
||||||
|
uvmta.a_int:=t;
|
||||||
|
inc(t);
|
||||||
|
|
||||||
|
uvmta_a.int:=t;
|
||||||
|
|
||||||
|
if (uvmta_a.int - uvmta.a_int <> 1) then
|
||||||
|
begin
|
||||||
|
Writeln('Error in generated executable');
|
||||||
|
if (@int = @a_int) then
|
||||||
|
Writeln('Both variables are at same address');
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
test;
|
||||||
|
a_test;
|
||||||
|
if (test_count <> 1) or
|
||||||
|
(a_test_count <> 1) then
|
||||||
|
begin
|
||||||
|
Writeln('Wrong code generated');
|
||||||
|
halt(2);
|
||||||
|
end;
|
||||||
|
end.
|
@ -6,10 +6,12 @@ unit uvmt;
|
|||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
|
{$ifndef VAR_ONLY}
|
||||||
type
|
type
|
||||||
a_tclass = class (tobject)
|
a_tclass = class (tobject)
|
||||||
x : integer;
|
x : integer;
|
||||||
end;
|
end;
|
||||||
|
{$endif ndef VAR_ONLY}
|
||||||
|
|
||||||
var
|
var
|
||||||
a_int : longint;
|
a_int : longint;
|
||||||
|
@ -6,10 +6,12 @@ unit uvmt_a;
|
|||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
|
{$ifndef VAR_ONLY}
|
||||||
type
|
type
|
||||||
tclass = class (tobject)
|
tclass = class (tobject)
|
||||||
x : integer;
|
x : integer;
|
||||||
end;
|
end;
|
||||||
|
{$endif ndef VAR_ONLY}
|
||||||
var
|
var
|
||||||
int : longint;
|
int : longint;
|
||||||
|
|
||||||
|
22
tests/webtbs/uvmta.pp
Executable file
22
tests/webtbs/uvmta.pp
Executable file
@ -0,0 +1,22 @@
|
|||||||
|
unit uvmta;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
var
|
||||||
|
a_int : longint;
|
||||||
|
|
||||||
|
const
|
||||||
|
a_test_count : longint = 0;
|
||||||
|
|
||||||
|
procedure a_test;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure a_test;
|
||||||
|
begin
|
||||||
|
Writeln('Procedure a_test in uvmt unit');
|
||||||
|
inc(a_test_count);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
22
tests/webtbs/uvmta_a.pp
Executable file
22
tests/webtbs/uvmta_a.pp
Executable file
@ -0,0 +1,22 @@
|
|||||||
|
unit uvmta_a;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
var
|
||||||
|
int : longint;
|
||||||
|
|
||||||
|
const
|
||||||
|
test_count : longint = 0;
|
||||||
|
|
||||||
|
|
||||||
|
procedure test;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure test;
|
||||||
|
begin
|
||||||
|
Writeln('Procedure test in uvmt_a unit');
|
||||||
|
inc(test_count);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user