+ Add similar checks for unit constants and procedures

git-svn-id: trunk@18928 -

.gitattributes

@@ -11757,6 +11757,7 @@ tests/webtbs/tw20035a.pp svneol=native#text/pascal
 tests/webtbs/tw20035b.pp svneol=native#text/pascal
 tests/webtbs/tw2004.pp svneol=native#text/plain
 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/tw2030.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/uvmt.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/uw0701c.pp svneol=native#text/plain
 tests/webtbs/uw0701d.pp svneol=native#text/plain

tests/webtbs/tw20093a.pp

@@ -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.

tests/webtbs/uvmt.pp

@@ -6,10 +6,12 @@ unit uvmt;
 
 interface
 
+{$ifndef VAR_ONLY}
 type
   a_tclass = class (tobject)
     x : integer;
   end;
+{$endif ndef VAR_ONLY}
 
 var
   a_int : longint;

tests/webtbs/uvmt_a.pp

@@ -6,10 +6,12 @@ unit uvmt_a;
 
 interface
 
+{$ifndef VAR_ONLY}
 type
   tclass = class (tobject)
     x : integer;
   end;
+{$endif ndef VAR_ONLY}
 var
   int : longint;
 

tests/webtbs/uvmta.pp

@@ -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.

tests/webtbs/uvmta_a.pp

@@ -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.