Merged revisions 1537-1538,1543,1592,1598,1600 via svnmerge from

http://[email protected]/svn/fpc/trunk

........
r1537 | florian | 2005-10-19 21:21:32 +0200 (Wed, 19 Oct 2005) | 2 lines

* initial version

........
r1538 | florian | 2005-10-19 21:25:49 +0200 (Wed, 19 Oct 2005) | 2 lines

* initial revision

........
r1543 | peter | 2005-10-20 12:52:56 +0200 (Thu, 20 Oct 2005) | 2 lines

  * fix typo

........
r1592 | olle | 2005-10-25 00:06:49 +0200 (Tue, 25 Oct 2005) | 1 line

new tests for mode macpas
........
r1598 | tom_at_work | 2005-10-26 21:43:50 +0200 (Wed, 26 Oct 2005) | 1 line

* removed some 32 bit specific test programs from the tests for ppc64
........
r1600 | tom_at_work | 2005-10-26 23:42:20 +0200 (Wed, 26 Oct 2005) | 1 line

* more testbench fixes
........

git-svn-id: branches/fixes_2_0@1610 -

.gitattributes

@@ -5072,10 +5072,12 @@ tests/test/tinterrupt.pp svneol=native#text/plain
 tests/test/tintuint.pp svneol=native#text/plain
 tests/test/tlibrary1.pp svneol=native#text/plain
 tests/test/tlibrary2.pp svneol=native#text/plain
+tests/test/tmacfunret.pp svneol=native#text/plain
 tests/test/tmacpas1.pp svneol=native#text/plain
 tests/test/tmacpas2.pp svneol=native#text/plain
 tests/test/tmacpas3.pp svneol=native#text/plain
 tests/test/tmacpas4.pp svneol=native#text/plain
+tests/test/tmacprocvar.pp svneol=native#text/plain
 tests/test/tmath1.pp svneol=native#text/plain
 tests/test/tmmx1.pp svneol=native#text/plain
 tests/test/tmove.pp svneol=native#text/plain
@@ -5967,6 +5969,7 @@ tests/webtbs/tw3691.pp svneol=native#text/plain
 tests/webtbs/tw3694.pp svneol=native#text/plain
 tests/webtbs/tw3695.pp svneol=native#text/plain
 tests/webtbs/tw3697.pp svneol=native#text/plain
+tests/webtbs/tw3700.pp -text svneol=unset#text/plain
 tests/webtbs/tw3708.pp svneol=native#text/plain
 tests/webtbs/tw3719.pp svneol=native#text/plain
 tests/webtbs/tw3721.pp svneol=native#text/plain
@@ -6011,6 +6014,7 @@ tests/webtbs/tw3971.pp svneol=native#text/plain
 tests/webtbs/tw3973.pp svneol=native#text/plain
 tests/webtbs/tw3977.pp svneol=native#text/plain
 tests/webtbs/tw3977.txt svneol=native#text/plain
+tests/webtbs/tw3997.pp -text svneol=unset#text/plain
 tests/webtbs/tw4006.pp svneol=native#text/plain
 tests/webtbs/tw4007.pp svneol=native#text/plain
 tests/webtbs/tw4009.pp svneol=native#text/plain

tests/tbf/tb0110.pp

@@ -1,4 +1,4 @@
-{ %skipcpu=x86_64 }
+{ %skipcpu=x86_64,powerpc64 }
 { %FAIL }
 
 {$mode delphi}

tests/tbf/tb0117.pp

@@ -1,4 +1,4 @@
-{ %skipcpu=x86_64 }
+{ %skipcpu=x86_64,powerpc64 }
 
 { %fail }
 

tests/tbs/tb0309.pp

@@ -51,7 +51,7 @@ begin
    p:=new(pa,init);
    p^.p;
    { the vmt pointer gets an invalid value: }
-   plongint(p)^:=longint(@data);
+   pptrint(p)^:=ptrint(@data);
    { causes runerror }
    p^.p;
    halt(1);

tests/test/tmacfunret.pp

@@ -0,0 +1,24 @@
+program tmacfunret;
+  {$MODE MACPAS}
+
+  procedure B(var x: Integer);
+
+  begin
+    x:= 42;
+  end;
+
+  function A: Integer;
+
+  begin
+    B(A);
+  end;
+
+var
+  i: Integer;
+
+begin
+  i:= A;
+  Writeln(i);
+  if i <> 42 then
+    halt(1);
+end.

tests/test/tmacprocvar.pp

@@ -0,0 +1,56 @@
+program tmacprocvar;
+
+{$MODE MACPAS}
+
+{Tests of different ways of handling functions in MW, THINK Pascal and FPC}
+
+	type
+		SInt8 = -128..127;
+		Ptr = ^SInt8;
+		ProcPtr = Ptr; {This is the definition of ProcPtr in Apples Univ Interfaces}
+
+	procedure A;
+
+	begin
+		Writeln('Hello');
+	end;
+
+	procedure B (procedure X);
+	begin
+		X;
+	end;
+
+{$IFC UNDEFINED THINK_Pascal }
+{ ** Not supported in THINK Pascal ** }
+
+	type
+		M = procedure;
+
+	var
+		n: M;
+
+	procedure C (Y: M);
+	begin
+		Y;
+	end;
+{$ENDC}
+
+	procedure D (Z: ProcPtr);
+	begin
+		Writeln(Ord(Z));
+	end;
+
+begin
+	B(A);
+	D(@A);
+  {$IFC UNDEFINED THINK_Pascal }
+  { ** Not supported in THINK Pascal ** }
+	B(@A);
+	n := nil;
+	n := A;
+	if nil <> n then
+		C(n);
+	C(A);
+	C(@A);
+  {$ENDC}
+end.

tests/webtbf/tw3626.pp

@@ -1,4 +1,4 @@
-{ %skipcpu=x86_64 }
+{ %skipcpu=x86_64,powerpc64 }
 { %fail }
 
 { Source provided for Free Pascal Bug Report 3626 }

tests/webtbs/tw3274.pp

@@ -4,7 +4,7 @@
 { Submitted by "Frank Kintrup" on  2004-08-27 }
 { e-mail: [email protected] }
 {$MODE Delphi}
-{$ASMODE Intel}
+{$ASMMODE Intel}
 
 var
   X : Integer;

tests/webtbs/tw3700.pp

@@ -0,0 +1,11 @@
+{ Source provided for Free Pascal Bug Report 3700 }
+{ Submitted by "Roman" on  2005-02-26 }
+{ e-mail: [email protected] }
+uses
+  variants;
+var
+  v : olevariant;
+  b : boolean;
+begin
+  b:=VarIsArray(V);
+end.

tests/webtbs/tw3997.pp

@@ -0,0 +1,75 @@
+{ Source provided for Free Pascal Bug Report 3997 }
+{ Submitted by "Dominique Louis" on  2005-05-21 }
+{ e-mail: [email protected] }
+
+{$mode delphi}
+program Project1;
+
+{$APPTYPE CONSOLE}
+
+uses
+  SysUtils;
+
+type
+  TMyNotifyEvent =  procedure of object;
+
+  TMyBaseWindow = class( TObject )
+  private
+    FOnRender: TMyNotifyEvent;
+  public
+    property OnRender: TMyNotifyEvent read FOnRender write FOnRender;
+  end;
+
+  TBaseInterface = class( TObject )
+  protected
+    procedure Render; virtual; abstract;
+  public
+    MainWindow : TMyBaseWindow;
+    constructor Create;
+    destructor Destroy; override;
+    procedure ResetInputManager;
+  end;
+
+  TMyInterface = class( TBaseInterface )
+  protected
+    procedure Render; override;
+  end;
+
+
+{ TBaseInterface }
+constructor TBaseInterface.Create;
+begin
+  inherited;
+  WriteLn( 'TBaseInterface.Create' );
+  MainWindow := TMyBaseWindow.Create;
+  ResetInputManager;
+end;
+
+destructor TBaseInterface.Destroy;
+begin
+  MainWindow.Free;
+  inherited;
+end;
+
+procedure TBaseInterface.ResetInputManager;
+begin
+  WriteLn( 'ResetInputManager' );
+  MainWindow.OnRender := Render;
+end;
+
+{ TMyInterface }
+procedure TMyInterface.Render;
+begin
+  WriteLn( 'Rendering' );
+end;
+
+var
+  MyInterface : TMyInterface;
+
+begin
+  MyInterface := TMyInterface.Create;
+
+  MyInterface.Render;
+
+  MyInterface.Free;
+end.