Merged revisions 533,552,592,635,645,651-652 via svnmerge from

/trunk

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

.gitattributes

@@ -5305,6 +5305,7 @@ tests/webtbf/tw3740.pp svneol=native#text/plain
 tests/webtbf/tw3790.pp svneol=native#text/plain
 tests/webtbf/tw3841.pp svneol=native#text/plain
 tests/webtbf/tw3969.pp svneol=native#text/plain
+tests/webtbf/tw4104.pp svneol=native#text/plain
 tests/webtbf/tw4111.pp svneol=native#text/plain
 tests/webtbf/uw0744.pp svneol=native#text/plain
 tests/webtbf/uw0840a.pp svneol=native#text/plain
@@ -5909,7 +5910,6 @@ tests/webtbs/tw3796.pp svneol=native#text/plain
 tests/webtbs/tw3805.pp svneol=native#text/plain
 tests/webtbs/tw3812.pp svneol=native#text/plain
 tests/webtbs/tw3814.pp svneol=native#text/plain
-tests/webtbs/tw3821.pp svneol=native#text/plain
 tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3833.pp svneol=native#text/plain
 tests/webtbs/tw3840.pp svneol=native#text/plain
@@ -5933,6 +5933,7 @@ tests/webtbs/tw3977.pp svneol=native#text/plain
 tests/webtbs/tw3977.txt svneol=native#text/plain
 tests/webtbs/tw4010.pp svneol=native#text/plain
 tests/webtbs/tw4013.pp svneol=native#text/plain
+tests/webtbs/tw4015.pp svneol=native#text/plain
 tests/webtbs/tw4038.pp svneol=native#text/plain
 tests/webtbs/tw4043.pp svneol=native#text/plain
 tests/webtbs/tw4055.pp svneol=native#text/plain
@@ -5941,8 +5942,10 @@ tests/webtbs/tw4078.pp svneol=native#text/plain
 tests/webtbs/tw4089.pp svneol=native#text/plain
 tests/webtbs/tw4093.pp svneol=native#text/plain
 tests/webtbs/tw4115.pp svneol=native#text/plain
+tests/webtbs/tw4119.pp svneol=native#text/plain
 tests/webtbs/tw4150.pp svneol=native#text/plain
 tests/webtbs/tw4155.pp svneol=native#text/plain
+tests/webtbs/tw4188.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

tests/webtbf/tw4104.pp

@@ -0,0 +1,32 @@
+{ %fail }
+{ Source provided for Free Pascal Bug Report 4104 }
+{ Submitted by "Daniël Mantione" on  2005-06-22 }
+{ e-mail: [email protected] }
+program bug;
+
+type junk=record
+       data:ansistring;
+     end;
+
+operator :=(x:longint) result:junk;
+
+begin
+  str(x,result.data);
+end;
+
+procedure write_junk(const data:array of junk);
+
+var i:cardinal;
+
+begin
+  for i:=low(data) to high(data) do
+   begin
+     write(data[i].data);
+     write('<-->');
+     writeln(Pchar(data[i].data));
+   end;
+end;
+
+begin
+  write_junk([1,2]);
+end.

tests/webtbs/tw3821.pp

@@ -1,18 +0,0 @@
-{ %OPT=-Sew }
-
-{ Source provided for Free Pascal Bug Report 3821 }
-{ Submitted by "Matthias Hryniszak" on  2005-03-24 }
-{ e-mail: [email protected] }
-program Test;
-
-uses
-  SyncObjs;
-
-var
-  Event: TSimpleEvent;
-
-begin
-  // The following line produces a compile-time
-  // warning
-  Event := TSimpleEvent.Create;
-end.

tests/webtbs/tw4015.pp

@@ -0,0 +1,84 @@
+{ Source provided for Free Pascal Bug Report 4015 }
+{ Submitted by "Radoslaw Stachowiak" on  2005-05-25 }
+{ e-mail: [email protected] }
+unit tw4015;
+{$mode objfpc}
+{$inline on}
+{$H+}
+interface
+
+type
+  TComponent = class;
+
+  { TComponentContainer }
+  TComponentContainer = class
+  private
+    acount: integer;
+    components: array of TComponent;
+    function fGet(ind: integer): TComponent; inline;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    property Component[ind: integer]: TComponent read fGet; default;
+    property Count: integer read acount;
+  end;
+
+
+  { TComponent }
+  TComponent = class
+  protected
+    achildren: TComponentContainer;
+  public
+    constructor Create(const parent: TComponent);
+    destructor Destroy; override;
+  end;
+
+implementation
+
+{ TComponentContainer }
+function TComponentContainer.fGet(ind: integer): TComponent; inline;
+begin
+  if (ind>=acount) or (ind<0) then
+    result := nil
+  else
+    result := components[ind];
+end;
+
+
+constructor TComponentContainer.Create;
+begin
+  inherited Create;
+
+  acount:=0;
+  SetLength(components, 10);
+end;
+
+destructor TComponentContainer.Destroy;
+begin
+  inherited Destroy;
+end;
+
+{ TComponent }
+constructor TComponent.Create(const parent: TComponent);
+begin
+  inherited Create;
+  achildren := TComponentContainer.Create;
+end;
+
+destructor TComponent.Destroy;
+var
+  i: integer;
+begin
+  for i:=0 to achildren.Count-1 do
+  begin
+    achildren[i].Free(); //Internal Error 200108231
+    {if above line is changed to (var c: TComponent):
+     c := achildren[i]; //Internal Error 200108231
+     c.Free();
+     }
+  end;
+  achildren.Free;
+  inherited Destroy;
+end;
+
+end.

tests/webtbs/tw4119.pp

@@ -0,0 +1,35 @@
+{ Source provided for Free Pascal Bug Report 4119 }
+{ Submitted by "C Western" on  2005-06-26 }
+{ e-mail: [email protected] }
+
+{$mode delphi}
+
+uses StrUtils;
+
+function mypos(s1,s2 : widestring) : integer;overload;
+  begin
+    result:=pos(s1,s2);
+  end;
+
+function mypos(s1,s2 : ansistring) : integer;overload;
+  begin
+    result:=pos(s1,s2);
+  end;
+
+function mypos(s1,s2 : shortstring) : integer;overload;
+  begin
+    result:=pos(s1,s2);
+  end;
+
+var
+ s:AnsiString;
+ p:ShortString;
+ ws:widestring;
+begin
+  s:=DupeString('a',300)+'b';
+  ws:=s;
+  p:='b';
+  WriteLn(MyPos('b',s));
+  WriteLn(MyPos(p,s));
+  WriteLn(MyPos(p,ws));
+end.

tests/webtbs/tw4188.pp

@@ -0,0 +1,29 @@
+{ Source provided for Free Pascal Bug Report 4188 }
+{ Submitted by "guy simon" on  2005-07-14 }
+{ e-mail: [email protected] }
+PROGRAM CODESTRING ;
+VAR
+
+ A, B, C : STRING;
+ I, N : BYTE ;
+
+BEGIN
+ RANDSEED := 3455;
+ A :='AZERTYUIOP0123456';
+ N := LENGTH(A);
+ WRITELN('SOURCE STRING : ',A);
+
+{ NOW CODING A INTO B }
+ B := '' ;
+ FOR I := 1 TO N DO B:= B + CHR ( ORD(A[I]) XOR RANDOM(256) );
+ WRITELN('CODED STRING : ',B);
+
+{ NOW DECODING B INTO C}
+ RANDSEED := 3455;
+ C := '';
+ FOR I :=1 TO N DO C:= C + CHR ( ORD(B[I]) XOR RANDOM(256) );
+ WRITELN('DECODED STRING : ',C);
+
+ if C<>A then
+   halt(1);
+END.