* new bugs

tests/webtbs/tw3470.pp

@@ -0,0 +1,24 @@
+{$ifdef fpc}{$mode delphi}{$endif}
+uses Variants;
+
+type
+  IBla = interface
+  end;
+
+  TBla = class(TInterfacedObject, IBla)
+  public
+    constructor Create;
+  end;
+
+constructor TBla.Create;
+begin
+end;
+
+var
+  v: Variant;
+  bla: IBla;
+begin
+  bla := TBla.Create;
+  v := bla;
+end.
+

tests/webtbs/tw3474.pp

@@ -0,0 +1,17 @@
+{ %recompile }
+
+unit tw3474;
+
+interface
+
+uses uw3474b;
+
+implementation
+
+procedure StaticOnCreateDevice;
+begin
+  if V_Failed(0) then Exit;
+end;
+
+end.
+

tests/webtbs/tw3477.pp

@@ -0,0 +1,34 @@
+{ Source provided for Free Pascal Bug Report 3477 }
+{ Submitted by "Michalis Kamburelis" on  2004-12-26 }
+{ e-mail: michalis@camelot.homedns.org }
+{ Prints
+    666666
+    6666666
+    0000000066666666
+    0000000666666666
+    0000006666666666
+  Should print (and does after applying my simple patch)
+    666666
+    6666666
+    66666666
+    666666666
+    6666666666
+}
+
+uses SysUtils,erroru;
+
+procedure Check(a,b:ansistring);
+begin
+  writeln(a);
+  if a<>b then
+    error;
+end;
+
+begin
+ Check(Format('%x', [$666666]),'666666');
+ Check(Format('%x', [$6666666]),'6666666');
+ Check(Format('%x', [$66666666]),'66666666');
+ Check(Format('%x', [$666666666]),'666666666');
+ Check(Format('%x', [$6666666666]),'6666666666');
+end.
+

tests/webtbs/tw3478.pp

@@ -0,0 +1,48 @@
+{ Source provided for Free Pascal Bug Report 3478 }
+{ Submitted by "Michalis Kamburelis" on  2004-12-26 }
+{ e-mail: michalis@camelot.homedns.org }
+{ Before fixing bug 3477 this prints
+    FFFFFFF
+    FFFFFFFFFFFFFFFF
+    0000000FFFFFFFFF
+    9999999
+    FFFFFFFF99999999
+    0000000999999999
+
+  After fixing 3477 with my patch this prints
+    FFFFFFF
+    FFFFFFFFFFFFFFFF
+    FFFFFFFFF
+    9999999
+    FFFFFFFF99999999
+    999999999
+  so part of the problems are gone, but not all.
+
+  Then, after fixing this bug with my simple patch it correctly prints
+    FFFFFFF
+    FFFFFFFF
+    FFFFFFFFF
+    9999999
+    99999999
+    999999999
+}
+
+uses SysUtils,erroru;
+
+procedure Check(a,b:ansistring);
+begin
+  writeln(a);
+  if a<>b then
+    error;
+end;
+
+begin
+ check(Format('%x', [$FFFFFFF]),'FFFFFFF');
+ check(Format('%x', [$FFFFFFFF]),'FFFFFFFF');
+ check(Format('%x', [$FFFFFFFFF]),'FFFFFFFFF');
+
+ check(Format('%x', [$9999999]),'9999999');
+ check(Format('%x', [$99999999]),'99999999');
+ check(Format('%x', [$999999999]),'999999999');
+end.
+

tests/webtbs/tw3479.pp

@@ -0,0 +1,18 @@
+{ Source provided for Free Pascal Bug Report 3479 }
+{ Submitted by "Michalis Kamburelis" on  2004-12-26 }
+{ e-mail: michalis@camelot.homedns.org }
+{ Two cases where BreakStr = #10 hang WrapText.
+  After applying my fix all things work OK.
+}
+
+uses SysUtils;
+const
+  Line1 = 'one blahblah blah bb b';
+  Line2 = 'two hhhhh sss sssss wwwww';
+begin
+ Writeln(WrapText(Line1 +   #10+ Line2,    #10, [' '], 40));
+ Writeln(WrapText(Line1 +#13#10+ Line2, #13#10, [' '], 40));
+ Writeln(WrapText(Line1 +   #10+ Line2,    #10, [' '], 10));
+ Writeln(WrapText(Line1 +#13#10+ Line2, #13#10, [' '], 10));
+end.
+

tests/webtbs/uw3474a.pp

@@ -0,0 +1,9 @@
+unit uw3474a;
+
+interface
+
+implementation
+
+uses tw3474;
+
+end.

tests/webtbs/uw3474b.pp

@@ -0,0 +1,21 @@
+{ Source provided for Free Pascal Bug Report 3474 }
+{ Submitted by "Alexey Barkovoy" on  2004-12-26 }
+{ e-mail: clootie@ixbt.com }
+unit uw3474b;
+
+interface
+
+{$INLINE ON}
+{$MODE DELPHI}
+function V_Failed(Status: HRESULT): Boolean; inline;
+
+implementation
+
+uses uw3474a;
+
+function V_Failed(Status: HRESULT): Boolean;
+begin
+  Result := Status <> 0;
+end;
+
+end.