Merged revisions 7129,7138,7196 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r7129 | pierre | 2007-04-18 09:25:24 +0200 (Wed, 18 Apr 2007) | 1 line

 * add mode objfpc directive
........
r7138 | florian | 2007-04-19 22:25:02 +0200 (Thu, 19 Apr 2007) | 2 lines

+ new test

........
r7196 | florian | 2007-04-29 19:58:50 +0200 (Sun, 29 Apr 2007) | 2 lines

* new tests derived from tw8777 so we avoid that it is forgotten

........

git-svn-id: branches/fixes_2_2@7222 -

.gitattributes

@@ -7194,6 +7194,9 @@ tests/webtbf/tw8398.pp svneol=native#text/plain
 tests/webtbf/tw8528.pp svneol=native#text/plain
 tests/webtbf/tw8583.pp svneol=native#text/plain
 tests/webtbf/tw8588.pp svneol=native#text/plain
+tests/webtbf/tw8777a.pp svneol=native#text/plain
+tests/webtbf/tw8777b.pp svneol=native#text/plain
+tests/webtbf/tw8777c.pp svneol=native#text/plain
 tests/webtbf/uw0744.pp svneol=native#text/plain
 tests/webtbf/uw0840a.pp svneol=native#text/plain
 tests/webtbf/uw0840b.pp svneol=native#text/plain
@@ -8073,6 +8076,7 @@ tests/webtbs/tw8371.pp svneol=native#text/plain
 tests/webtbs/tw8391.pp svneol=native#text/plain
 tests/webtbs/tw8434.pp svneol=native#text/plain
 tests/webtbs/tw8462.pp svneol=native#text/plain
+tests/webtbs/tw8465.pp svneol=native#text/plain
 tests/webtbs/tw8513.pp svneol=native#text/plain
 tests/webtbs/tw8573.pp svneol=native#text/plain
 tests/webtbs/tw8615.pp svneol=native#text/plain

tests/webtbf/tw8777a.pp

@@ -0,0 +1,34 @@
+{ %fail }
+program BugTest;
+
+{$mode objfpc}
+
+type
+  TTest = class
+  private
+    FTest: Integer;
+    procedure SetTest(const Value: Integer);
+  public
+    property Test: Integer read FTest write SetTest;
+  end;
+
+procedure p(var i : longint);
+  begin
+  end;
+
+{ TTest }
+
+procedure TTest.SetTest(const Value: Integer);
+begin
+  Writeln('SetTest called!');
+  FTest := Value;
+end;
+
+var
+  Test: TTest;
+
+begin
+  Test := TTest.Create;
+  Test.Test := 2;
+  p(Test.Test);
+end.

tests/webtbf/tw8777b.pp

@@ -0,0 +1,34 @@
+{ %fail }
+program BugTest;
+
+{$mode objfpc}
+
+type
+  TTest = class
+  private
+    FTest: Integer;
+    procedure SetTest(const Value: Integer);
+  public
+    property Test: Integer read FTest write SetTest;
+  end;
+
+procedure p(var i : longint);
+  begin
+  end;
+
+{ TTest }
+
+procedure TTest.SetTest(const Value: Integer);
+begin
+  Writeln('SetTest called!');
+  FTest := Value;
+end;
+
+var
+  Test: TTest;
+
+begin
+  Test := TTest.Create;
+  Test.Test := 2;
+  inc(Test.Test);
+end.

tests/webtbf/tw8777c.pp

@@ -0,0 +1,34 @@
+{ %fail }
+program BugTest;
+
+{$mode objfpc}
+
+type
+  TTest = class
+  private
+    FTest: Integer;
+    procedure SetTest(const Value: Integer);
+  public
+    property Test: Integer read FTest write SetTest;
+  end;
+
+procedure p(var i : longint);
+  begin
+  end;
+
+{ TTest }
+
+procedure TTest.SetTest(const Value: Integer);
+begin
+  Writeln('SetTest called!');
+  FTest := Value;
+end;
+
+var
+  Test: TTest;
+
+begin
+  Test := TTest.Create;
+  Test.Test := 2;
+  ReadLn(Test.Test);
+end.

tests/webtbs/tw8465.pp

@@ -0,0 +1,20 @@
+program EnumPtrConvTest;
+
+{$APPTYPE CONSOLE}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+type
+  TEnum = (a, b);
+
+var
+  e: TEnum;
+  p: Pointer;
+
+begin
+  e := b;
+  p := Pointer(e);
+  WriteLn(Integer(p)); // produces "1" in Delphi
+end.

tests/webtbs/tw8660.pp

@@ -1,3 +1,6 @@
+
+{$mode objfpc}
+
 program TestGetSetProp;
 {$APPTYPE CONSOLE}{$PACKSET 1}
 
@@ -31,4 +34,4 @@ begin
   if GetSetProp(C, 'St')<>'ckNormal,ckVip' then
     halt(1);
   writeln('ok');
-end.
+end.