* new bugs from the web

tests/webtbf/tw1851.pp

@@ -0,0 +1,19 @@
+{ %opt=-Sew }
+
+{$mode objfpc}{$H+}
+
+function A: boolean;
+
+  procedure CheckResult;
+  begin
+    if not Result then writeln('Oha');
+  end;
+
+begin
+  Result:=false;
+  CheckResult;
+end;
+
+begin
+  A;
+end.

tests/webtbf/tw1902.pp

@@ -0,0 +1,26 @@
+{ %cpu=i386 }
+
+{$ifdef fpc}
+{$MODE DELPHI}
+{$ASMMODE INTEL}
+{$endif}
+
+const myoffset=10;
+
+var
+  r : array[0..19] of char;
+  c : char;
+begin
+  r:='01234567890123456789';
+  asm
+   lea eax,r
+   mov al,[eax].myoffset
+   mov c,al
+  end;
+  writeln(c);
+  if c<>'0' then
+   begin
+     writeln('ERROR!');
+     halt(1);
+   end;
+end.

tests/webtbf/tw1905.pp

@@ -0,0 +1,10 @@
+{ %fail }
+
+procedure proc_value_smallset(smallset : set of tsmallset);
+   begin
+     if [A_A,A_D] in smallset then
+       global_u8bit := RESULT_U8BIT;
+   end;
+
+begin
+end.

tests/webtbs/tw1856.pp

@@ -0,0 +1,20 @@
+{ %ver=1.1 }
+
+{$mode objfpc}
+
+type
+ TFlowItem = class
+  text: string; //replace with "shortstring" and the crash goes away
+ end;
+
+ TFlow = array of TFlowItem;
+
+var
+ flow: tflow;
+begin
+ setlength(flow, 10);
+ setlength(flow, 1);
+ { release }
+ setlength(flow, 0);
+ writeln('no crash');
+end.

tests/webtbs/tw1862.pp

@@ -0,0 +1,11 @@
+var x : array[1..1000] of double;
+    z : array[1..100] of double absolute x;
+
+begin
+  z[10]:=10.0;
+  if x[10]<>10.0 then
+   begin
+     writeln('ERROR!');
+     halt(1);
+   end;
+end.

tests/webtbs/tw1863.pp

@@ -0,0 +1,56 @@
+
+type
+ TObj =   object
+  constructor Init0;
+  constructor Init;
+  procedure   Show;
+  function    GetStr:string; virtual;
+  destructor  Done;
+ end;
+
+ TChild = object (TObj)
+   function GetStr:string; virtual;
+ end;
+
+var
+  Err : boolean;
+
+constructor TObj.Init0;
+begin
+end;
+
+constructor TObj.Init;
+begin
+  Init0;
+end;
+
+function   TObj.GetStr:string;
+begin
+  GetStr:='Bad';
+  Err:=true;
+end;
+
+procedure  TObj.Show;
+begin
+  writeln(GetStr);
+end;
+
+destructor TObj.Done;
+begin
+end;
+
+function TChild.GetStr:string;
+begin
+  GetStr:='Good'
+end;
+
+var
+  Obj:TChild;
+begin
+ Obj.Init;
+ Obj.Show;
+ Obj.Done;
+ if Err then
+  halt(1);
+end.
+

tests/webtbs/tw1867.pp

@@ -0,0 +1,13 @@
+uses SysUtils;
+
+var
+  s : string;
+begin
+  s:=formatdatetime ('hh:nn:ss.zzz', encodetime (12, 30, 44, 4));
+  writeln(s);
+  if s<>'12:30:44.004' then
+   begin
+     writeln('ERROR!');
+     halt(1);
+   end;
+end.

tests/webtbs/tw1883.pp

@@ -0,0 +1,6 @@
+{ %ver=1.1 }
+
+begin
+{ Default extension .pp and .pas should be searched }
+{$i ub1883}
+end.

tests/webtbs/tw1888.pp

@@ -0,0 +1,46 @@
+program dumpprops;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+uses
+  Classes, TypInfo;
+
+type
+  TBaseTest = class(TPersistent)
+  private
+    FCaption: String;
+    FNext: Integer;
+  protected
+  public
+    property Caption: String read FCaption write FCaption;
+  published
+    property Next: Integer read FNext write FNext;
+  end;
+
+  TTest = class(TBaseTest)
+  private
+    FNext2: Integer;
+  protected
+  public
+  published
+    property Caption;
+    property Next2: Integer read FNext2 write FNext2;
+  end;
+
+var
+  p : PPropInfo;
+  t : TTest;
+begin
+  t:=TTest.Create;
+  p:=GetPropInfo(t,'Next');
+  if (p<>nil) and
+     (p^.name='Next') then
+   writeln('Success')
+  else
+   begin
+     writeln('ERROR!');
+     halt(1);
+   end;
+end.

tests/webtbs/tw1889.pp

@@ -0,0 +1,12 @@
+var
+    t,t1:int64;
+    tsclo,tschi:cardinal;
+    f:int64;
+begin
+  tschi:=1;
+  tsclo:=0;
+  f:=1;
+  t1:=2;
+  t:=1;
+  writeln(((Int64(tscHi) shl 32 + tscLo) / ((T1-T) / F)));
+end.

tests/webtbs/tw1896.pp

@@ -0,0 +1,24 @@
+var
+  value:real;
+  fin:text;
+begin
+  assign(fin,'tw1896.tmp');
+  rewrite(fin);
+  writeln(fin,'12.3');
+  writeln(fin,'13.2');
+  close(fin);
+
+  assign(fin,'tw1896.tmp');
+  reset(fin);
+  while not eof(fin) do
+  begin
+  read(fin,value);
+  writeln(value)
+  end;
+  { Delphi returns 0 as last value }
+  if value<>0 then
+   begin
+     writeln('Error');
+     halt(1);
+   end;
+end.

tests/webtbs/tw1901.pp

@@ -0,0 +1,32 @@
+{ %version=1.1 }
+
+{$ifdef fpc}
+{$MODE DELPHI}
+{$endif}
+
+const Inf=1/0;
+      NaN=0/0;
+      MinusInf=-Inf;
+var
+  s : string;
+  error : boolean;
+begin
+  error:=false;
+  str(Inf,s);
+  writeln('Inf: "',s,'"');
+  if s<>'                   +Inf' then
+   error:=true;
+  str(NaN,s);
+  writeln('Nan: "',s,'"');
+  if s<>'                    Nan' then
+   error:=true;
+  str(MinusInf,s);
+  writeln('MinusInf: "',s,'"');
+  if s<>'                   -Inf' then
+   error:=true;
+  if error then
+   begin
+     writeln('ERROR!');
+     halt(1);
+   end;
+end.

tests/webtbs/tw1902.pp

@@ -0,0 +1,26 @@
+{ %cpu=i386 }
+
+{$ifdef fpc}
+{$MODE DELPHI}
+{$ASMMODE INTEL}
+{$endif}
+
+const myoffset=10;
+
+var
+  r : array[0..19] of char;
+  c : char;
+begin
+  r:='01234567890123456789';
+  asm
+   lea eax,r
+   mov al,[eax].myoffset
+   mov c,al
+  end;
+  writeln(c);
+  if c<>'0' then
+   begin
+     writeln('ERROR!');
+     halt(1);
+   end;
+end.

tests/webtbs/tw1908.pp

@@ -0,0 +1,25 @@
+uses SysUtils;
+
+{$mode objfpc}
+
+{$R+}
+procedure x(arr : array of byte);
+ begin
+   try
+    if arr[12] <> $55 then
+      WriteLn('Error! No Rangecheck error detected');
+    Halt(1);
+   except
+     on e : exception do
+       begin
+         Writeln(e.message);
+       end;
+   end;
+ end;
+
+var
+ arr : array[1..12] of byte;
+begin
+ arr[12] := $55;
+ x(arr);
+end.

tests/webtbs/tw1917.pp

@@ -0,0 +1,22 @@
+{$mode objfpc}
+
+uses SysUtils;
+
+var
+  x,y,z : real;
+
+begin
+  x:=5.75;
+  y:=5.75;
+  z:=6;
+  try
+    z:=z/ln(x/y);
+    WriteLn('Error! No runtime error detected');
+    Writeln('z = ',z);
+  except
+     on e : exception do
+       begin
+         Writeln('Correct, found error: ',e.message);
+       end;
+  end;
+end.