* new bugs

tests/webtbs/tw1948.pp

@@ -0,0 +1,14 @@
+{ %opt=-Sew }
+
+{ Source provided for Free Pascal Bug Report 1948 }
+{ Submitted by "Sergey Kosarevsky" on  2002-04-27 }
+{ e-mail: [email protected] }
+Function A:Longint;
+Begin
+   Exit(0);
+End;
+
+Begin
+   A;
+End.
+

tests/webtbs/tw2158.pp

@@ -0,0 +1,26 @@
+{ %cpu=i386 }
+
+{ Source provided for Free Pascal Bug Report 2158 }
+{ Submitted by "Maxim Voronov" on  2002-10-03 }
+{ e-mail: [email protected] }
+
+{$asmmode intel}
+
+  Function TestProc:single;
+    begin
+      asm
+        push    eax
+        fldz
+        fldz
+        fldz
+        fsubp   st(2),st(0)
+        fstp    st(0)
+        pop     eax
+      end;
+    end;
+
+  Begin
+    writeln;
+    writeln(TestProc);
+  End.
+

tests/webtbs/tw2159.pp

@@ -0,0 +1,17 @@
+{ %version=1.1 }
+
+{ Source provided for Free Pascal Bug Report 2159 }
+{ Submitted by "Yakov Sudeikin" on  2002-10-03 }
+{ e-mail: [email protected] }
+{$mode objfpc}
+
+var
+ a,b,c: array of string;
+begin
+ setlength(a, 2);
+ a[0] := 'asd';
+ a[1] := 'qwe';
+ b := copy(a);
+ c := copy(a, 1, 1);
+end.
+

tests/webtbs/tw2174.pp

@@ -0,0 +1,36 @@
+{ Source provided for Free Pascal Bug Report 2174 }
+{ Submitted by "Maarten Bekers" on  2002-10-13 }
+{ e-mail: [email protected] }
+
+{$mode delphi}
+
+program test;
+
+type StringArrayObj = Object
+          constructor Init(AllocStrings: Longint);
+          destructor Done;
+     end; { StringArrayObj }
+
+type pStringArrayObj = ^StringArrayObj;
+
+constructor StringArrayObj.Init(AllocStrings: Longint);
+begin
+end; { constructor Init }
+
+destructor StringArrayObj.Done;
+begin
+end; { destructor Done }
+
+var
+  oo2,oo3: ^stringarrayobj;
+
+begin
+{!!!}
+new(oo2, init);
+new(oo3, init);
+
+writeln('one');
+writeln('two!');
+{!!!}
+end.
+

tests/webtbs/tw2176.pp

@@ -0,0 +1,42 @@
+{ %version=1.1}
+
+{ Source provided for Free Pascal Bug Report 2176 }
+{ Submitted by "Rimgaudas" on  2002-10-14 }
+{ e-mail: [email protected] }
+{$ifdef fpc}{$mode delphi}{$endif}
+
+uses
+  SysUtils;
+
+type
+  ii= interface
+  ['{616D9683-88DC-4D1C-B847-1293DDFBACF7}']
+    procedure Show;stdcall;
+  end;
+
+  Twii= class(TInterfacedObject, ii)
+    s: string;
+    procedure Show;stdcall;
+  end;
+
+  procedure Twii.Show;stdcall;
+  begin
+    WriteLn(s);
+  end;
+
+var
+  wii: twii;
+  i: ii;
+
+begin
+  try
+    wii:= Twii.create;
+    wii.s:='OK';
+    i:= ii(wii);
+    i.Show;        //writes nothing
+  except           //does not excepts
+    WriteLn('Problem');
+  end;
+  //in delphi it works OK
+end.
+

tests/webtbs/tw2177.pp

@@ -0,0 +1,65 @@
+{ %version=1.1 }
+
+{ Source provided for Free Pascal Bug Report 2177 }
+{ Submitted by "Rimgaudas" on  2002-10-14 }
+{ e-mail: [email protected] }
+{$ifdef fpc}{$mode delphi}{$endif}
+
+uses
+  SysUtils;
+
+type
+  ii= interface
+  ['{616D9683-88DC-4D1C-B847-1293DDFBACF7}']
+    procedure Show;stdcall;
+  end;
+
+  Twii= class(TObject, ii)
+    s: string;
+    function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
+    function _AddRef: Integer; stdcall;
+    function _Release: Integer; stdcall;
+
+    procedure Show;stdcall;
+  end;
+
+  {________doomy interfaces______}
+  function Twii.QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
+  begin
+    result:= -1;
+  end;
+
+  function Twii._AddRef: Integer; stdcall;
+  begin
+    result:= -1;
+  end;
+
+  function Twii._Release: Integer; stdcall;
+  begin
+    result:= -1;
+  end;
+  {________doomy interfaces______}
+
+
+  procedure Twii.Show;stdcall;
+  begin
+    WriteLn(s);
+  end;
+
+var
+  wii: twii;
+  i: ii;
+
+begin
+  try
+    wii:= Twii.create;
+    wii.s:='OK';
+    i:= ii(wii);
+    i.Show;
+  except       //excepts
+    on EAccessViolation do WriteLn('Access Violation');
+  else
+    WriteLn('Problem');
+  end;
+end.
+

tests/webtbs/tw2185.pp

@@ -0,0 +1,60 @@
+{ Source provided for Free Pascal Bug Report 2185 }
+{ Submitted by "Andrew Johnson" on  2002-10-16 }
+{ e-mail: [email protected] }
+Program BugTest;
+
+{$Mode ObjFPC}{$H+}
+{off $Define InvertOrder}
+
+Uses Classes;
+
+Type
+  TMyClass = Class(TPersistent)
+  public
+    dummy : Longint;
+    {$IfNDef InvertOrder}
+      procedure Assign(Source : TPersistent); override;
+      procedure Assign(const value: integer);
+    {$Else InvertOrder}
+      procedure Assign(const value: integer);
+      procedure Assign(Source : TPersistent); override;
+    {$EndIf InvertOrder}
+
+    Constructor Create;
+  end;
+
+procedure TMyClass.Assign(Source : TPersistent);
+begin
+  If Source is TMyClass then
+    Dummy := TMyClass(Source).dummy;
+end;
+
+procedure TMyClass.Assign(const value: integer);
+begin
+  Dummy := value;
+end;
+
+Constructor TMyClass.Create;
+begin
+  Inherited Create;
+end;
+
+Const
+  ConstDummy : Integer = 3;
+
+var
+  Test1, Test2 : TMyClass;
+begin
+  Test1 := TMyClass.Create;
+  Test2 := TMyClass.Create;
+  Test1.Dummy := 2;
+  Test2.Dummy := 1;
+  Writeln(Test2.Dummy);
+  Test2.Assign(Test1);
+  Writeln(Test2.Dummy);
+  Test2.Assign(ConstDummy);
+  Writeln(Test2.Dummy);
+  Test1.Destroy;
+  Test2.Destroy;
+end.
+

tests/webtbs/tw2186.pp

@@ -0,0 +1,18 @@
+{ Source provided for Free Pascal Bug Report 2186 }
+{ Submitted by "Andrew Johnson" on  2002-10-16 }
+{ e-mail: [email protected] }
+Program TypeBug;
+
+{$Mode ObjFPC}
+Uses Classes;
+
+Type
+  NewInt = type longint;
+
+  TSomeClass = Class(TComponent)
+  end;
+
+begin
+
+end.
+