* new tests

git-svn-id: trunk@7409 -

.gitattributes

@@ -8096,6 +8096,7 @@ tests/webtbs/tw5094.pp svneol=native#text/plain
 tests/webtbs/tw5100.pp svneol=native#text/plain
 tests/webtbs/tw5100a.pp svneol=native#text/plain
 tests/webtbs/tw5641.pp svneol=native#text/plain
+tests/webtbs/tw5800.pp svneol=native#text/plain
 tests/webtbs/tw5896.pp svneol=native#text/plain
 tests/webtbs/tw6129.pp svneol=native#text/plain
 tests/webtbs/tw6184.pp svneol=native#text/plain
@@ -8193,6 +8194,8 @@ tests/webtbs/tw8177a.pp -text
 tests/webtbs/tw8180.pp svneol=native#text/plain
 tests/webtbs/tw8183.pp svneol=native#text/plain
 tests/webtbs/tw8187.pp svneol=native#text/plain
+tests/webtbs/tw8195a.pp svneol=native#text/plain
+tests/webtbs/tw8195b.pp svneol=native#text/plain
 tests/webtbs/tw8199.pp svneol=native#text/plain
 tests/webtbs/tw8222.pp svneol=native#text/plain
 tests/webtbs/tw8222a.pp svneol=native#text/plain

tests/webtbs/tw5800.pp

@@ -0,0 +1,57 @@
+{$IFDEF FPC}{$mode objfpc}{$ENDIF}
+
+uses
+	sysutils;
+
+type
+{$INTERFACES CORBA}
+	IAny1 = interface
+		//['{949041BD-BEC9-468A-93AA-96B158EF97E0}']
+		procedure x;
+	end;
+
+	IAny2 = interface
+        //['{4743E9F5-74B2-411D-94CE-AAADDB8F45E0}']
+		procedure y;
+	end;
+
+	TAny = class(TInterfacedObject, IAny1, IAny2)
+		procedure x;
+		procedure y;
+	end;
+
+
+procedure TAny.x;
+begin
+	WriteLn('x');
+end;
+
+procedure TAny.y;
+begin
+	WriteLn('y');
+end;
+
+procedure any(const z : IAny1); overload;
+begin
+	z.x;
+end;
+
+procedure any(const z : IAny2); overload;
+begin
+	z.y;
+end;
+
+
+var
+	a : TAny;
+
+begin
+	a := TAny.Create();
+
+	if (supports(a, IAny1)) then begin end; // remove this line to get it compile
+
+	any(a as IAny1);
+	any(a as IAny2);
+
+	//a.Free();
+end.

tests/webtbs/tw8195a.pp

@@ -0,0 +1,129 @@
+{ %cpu=i386 }
+
+{$APPTYPE CONSOLE}
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+program AsmTest;
+
+type
+  TMyObject = class(TObject)
+    Field1 : Integer;
+    Field2 : Integer;
+    procedure VirtualMethod1; virtual;
+    procedure VirtualMethod2; virtual;
+  end;
+
+  TMyRecord = record
+    EAX : Integer;
+    EBX : Integer;
+    ECX : Integer;
+    EDX : Integer;
+  end;
+
+{ TMyObject }
+
+procedure TMyObject.VirtualMethod1;
+begin
+
+end;
+
+procedure TMyObject.VirtualMethod2;
+begin
+
+end;
+
+function VirtualMethodVMTOFFSET1: Integer;
+asm
+  mov eax, VMTOFFSET TMyObject.VirtualMethod1;
+end;
+
+function VirtualMethodVMTOFFSET2: Integer;
+asm
+  mov eax, VMTOFFSET TMyObject.VirtualMethod2;
+end;
+
+function IUnknownAddRefVMTOFFSET1: Integer;
+asm
+  mov eax, VMTOFFSET IUnknown._AddRef;
+end;
+
+function Field1: Integer;
+asm
+  mov eax, TMyObject.Field1;
+end;
+
+function Field1OFFSET: Integer;
+asm
+  mov eax, OFFSET TMyObject.Field1;
+end;
+
+var
+  _Test: Integer;
+
+function Test: Integer;
+asm
+  mov eax, _Test;
+end;
+
+function TestOFFSET: Integer;
+asm
+  mov eax, OFFSET _Test;
+end;
+
+function LabelOFFSET: Integer;
+asm
+  mov eax, OFFSET @@Exit
+  ret
+ @@Exit:
+end;
+
+function TMyObjectTYPE: Integer;
+asm
+  mov eax, TYPE TMyObject
+end;
+
+function TMyRecordTYPE: Integer;
+asm
+  mov eax, TYPE TMyRecord
+end;
+
+function FillMyRecord: TMyRecord;
+asm
+  mov [eax + TMyRecord.&eax], eax
+  mov [eax + TMyRecord.&ebx], ebx
+  mov [eax + TMyRecord.&ecx], ecx
+  mov [eax + TMyRecord.&edx], edx
+end;
+
+var
+  MyRecord : TMyRecord;
+
+begin
+  _Test := 123;
+
+  WriteLn('VirtualMethodVMTOFFSET1: ', VirtualMethodVMTOFFSET1);
+  WriteLn('VirtualMethodVMTOFFSET2: ', VirtualMethodVMTOFFSET2);
+  WriteLn('IUnknownAddRefVMTOFFSET1: ', IUnknownAddRefVMTOFFSET1);
+  WriteLn('Field1: ', Field1);
+  WriteLn('Field1OFFSET: ', Field1OFFSET);
+  WriteLn('Test: ', Test);
+  WriteLn('TestOFFSET: ', TestOFFSET);
+  WriteLn('LabelOFFSET: ', LabelOFFSET);
+  WriteLn('TMyObjectTYPE: ', TMyObjectTYPE);
+  WriteLn('TMyRecordTYPE: ', TMyRecordTYPE);
+
+  MyRecord.eax := 0;
+  MyRecord.ebx := 0;
+  MyRecord.ecx := 0;
+  MyRecord.edx := 0;
+
+  MyRecord := FillMyRecord;
+
+  WriteLn('MyRecord.eax: ', MyRecord.eax);
+  WriteLn('MyRecord.ebx: ', MyRecord.ebx);
+  WriteLn('MyRecord.ecx: ', MyRecord.ecx);
+  WriteLn('MyRecord.edx: ', MyRecord.edx);
+end.

tests/webtbs/tw8195b.pp

@@ -0,0 +1,26 @@
+{ %cpu=i386 }
+
+{$APPTYPE CONSOLE}
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+function Expression1: Integer;
+asm
+//  mov eax, 4 * 3 - 2 + (-1) / 2
+end;
+
+function Expression2: Integer;
+asm
+  mov eax, NOT 4 OR 3 AND 2 XOR 1 MOD 6 SHL 4 SHR 2
+end;
+
+
+begin
+  WriteLn('Expression1: ', Expression1);
+  WriteLn('Expression2: ', Expression2);
+  if (Expression1<>10) or (Expression2<>-1) then
+    halt(1);
+end.
+