--- Merging r29537 into '.':

U    compiler/symdef.pas
A    tests/webtbs/tw27320.pp
A    tests/webtbs/uw27320.defaults.pp
--- Recording mergeinfo for merge of r29537 into '.':
 U   .
--- Merging r29579 into '.':
A    tests/webtbs/tw27348.pp
G    compiler/symdef.pas
--- Recording mergeinfo for merge of r29579 into '.':
 G   .
--- Merging r29743 into '.':
U    compiler/rautils.pas
G    compiler/symdef.pas
--- Recording mergeinfo for merge of r29743 into '.':
 G   .
--- Merging r29685 into '.':
A    tests/webtbs/tw27424.pp
U    compiler/pgenutil.pas
--- Recording mergeinfo for merge of r29685 into '.':
 G   .
--- Merging r30160 into '.':
U    rtl/inc/cgeneric.inc
--- Recording mergeinfo for merge of r30160 into '.':
 G   .
--- Merging r31028 into '.':
U    rtl/objpas/classes/classes.inc
A    tests/webtbs/tw28271.pp
--- Recording mergeinfo for merge of r31028 into '.':
 G   .

# revisions: 29537,29579,29743,29685,30160,31028

git-svn-id: branches/fixes_3_0@31065 -

.gitattributes

@@ -14212,10 +14212,13 @@ tests/webtbs/tw2729.pp svneol=native#text/plain
 tests/webtbs/tw27294.pp svneol=native#text/plain
 tests/webtbs/tw2730.pp svneol=native#text/plain
 tests/webtbs/tw2731.pp svneol=native#text/plain
+tests/webtbs/tw27320.pp svneol=native#text/pascal
+tests/webtbs/tw27348.pp svneol=native#text/pascal
 tests/webtbs/tw2736.pp svneol=native#text/plain
 tests/webtbs/tw2737.pp svneol=native#text/plain
 tests/webtbs/tw2738.pp svneol=native#text/plain
 tests/webtbs/tw2739.pp svneol=native#text/plain
+tests/webtbs/tw27424.pp svneol=native#text/pascal
 tests/webtbs/tw2758.pp svneol=native#text/plain
 tests/webtbs/tw2763.pp svneol=native#text/plain
 tests/webtbs/tw2765.pp svneol=native#text/plain
@@ -14236,6 +14239,7 @@ tests/webtbs/tw2809.pp svneol=native#text/plain
 tests/webtbs/tw2812.pp svneol=native#text/plain
 tests/webtbs/tw2815.pp svneol=native#text/plain
 tests/webtbs/tw2817.pp svneol=native#text/plain
+tests/webtbs/tw28271.pp svneol=native#text/pascal
 tests/webtbs/tw2829.pp svneol=native#text/plain
 tests/webtbs/tw2830.pp svneol=native#text/plain
 tests/webtbs/tw2832.pp svneol=native#text/plain
@@ -14955,6 +14959,7 @@ tests/webtbs/uw2706a.pp svneol=native#text/plain
 tests/webtbs/uw2706b.pp svneol=native#text/plain
 tests/webtbs/uw27294.pp svneol=native#text/plain
 tests/webtbs/uw2731.pp svneol=native#text/plain
+tests/webtbs/uw27320.defaults.pp svneol=native#text/pascal
 tests/webtbs/uw2738.pp svneol=native#text/plain
 tests/webtbs/uw2834.pp svneol=native#text/plain
 tests/webtbs/uw2920.pp svneol=native#text/plain

compiler/pgenutil.pas

@@ -1128,7 +1128,11 @@ uses
               firstidx:=result.count;
 
               constraintdata.free;
-            end;
+            end
+          else
+            if token=_SEMICOLON then
+              { a semicolon terminates a type parameter group }
+              firstidx:=result.count;
         until not (try_to_consume(_COMMA) or try_to_consume(_SEMICOLON));
         block_type:=old_block_type;
       end;

compiler/rautils.pas

@@ -1205,7 +1205,7 @@ Begin
          begin
            if tconstsym(srsym).consttyp=constord then
             Begin
-              l:=tconstsym(srsym).value.valueord.svalue;
+              l:=aint(tconstsym(srsym).value.valueord.svalue);
               SearchIConstant:=TRUE;
               exit;
             end;

compiler/symdef.pas

@@ -1244,8 +1244,12 @@ implementation
                        crc:=UpdateCrc32(crc,hs[1],length(hs));
                      end;
                  end;
-               hs:=hp.vardef.mangledparaname;
-               crc:=UpdateCrc32(crc,hs[1],length(hs));
+               if not is_void(tprocdef(st.defowner).returndef) then
+                 begin
+                   { add a little prefix so that x(integer; integer) is different from x(integer):integer }
+                   hs:='$$'+tprocdef(st.defowner).returndef.mangledparaname;
+                   crc:=UpdateCrc32(crc,hs[1],length(hs));
+                 end;
                s:=Copy(s,1,oldlen)+'$crc'+hexstr(crc,8);
              end;
            if prefix<>'' then
@@ -3417,8 +3421,10 @@ implementation
 
     constructor tarraydef.create_from_pointer(def:tpointerdef);
       begin
-         { use -1 so that the elecount will not overflow }
-         self.create(0,high(asizeint)-1,ptrsinttype);
+         { divide by the element size and do -1 so the array will have a valid size,
+           further, the element size might be 0 e.g. for empty records, so use max(...,1)
+           to avoid a division by zero }
+         self.create(0,(high(asizeint) div max(def.pointeddef.size,1))-1,ptrsinttype);
          arrayoptions:=[ado_IsConvertedPointer];
          setelementdef(def.pointeddef);
       end;
@@ -5507,8 +5513,12 @@ implementation
                     crc:=UpdateCrc32(crc,hs[1],length(hs));
                   end;
               end;
-            hs:=hp.vardef.mangledparaname;
-            crc:=UpdateCrc32(crc,hs[1],length(hs));
+            if not is_void(returndef) then
+              begin
+                { add a little prefix so that x(integer; integer) is different from x(integer):integer }
+                hs:='$$'+returndef.mangledparaname;
+                crc:=UpdateCrc32(crc,hs[1],length(hs));
+              end;
             defaultmangledname:=Copy(defaultmangledname,1,oldlen)+'$crc'+hexstr(crc,8);
           end;
       end;

rtl/inc/cgeneric.inc

@@ -49,7 +49,14 @@ end;
 {$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
 {$define FPC_SYSTEM_HAS_INDEXBYTE}
 
+{$ifdef LINUX}
+  {$define BUGGYMEMCHR}
+{$endif}
+
 function memchr(const buf; b: cint; len: size_t): pointer; cdecl; external 'c';
+{$ifdef BUGGYMEMCHR}
+function rawmemchr(const buf; b: cint): pointer; cdecl; external 'c';
+{$endif BUGGYMEMCHR}
 
 function IndexByte(Const buf;len:sizeint;b:byte):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif}
 var
@@ -60,7 +67,12 @@ begin
   { simulate assembler implementations behaviour, which is expected }
   { fpc_pchar_to_ansistr in astrings.inc (interpret values < 0 as   }
   { unsigned)                                                       }
-  res := memchr(buf,cint(b),size_t(sizeuint(len)));
+{$ifdef BUGGYMEMCHR}
+  if len = -1 then
+    res := rawmemchr(buf,cint(b))
+  else
+{$endif BUGGYMEMCHR}
+    res := memchr(buf,cint(b),size_t(sizeuint(len)));
   if (res <> nil) then
     IndexByte := SizeInt(res-@buf)
   else

rtl/objpas/classes/classes.inc

@@ -83,6 +83,9 @@ var
   { this list holds all instances of external threads that need to be freed at
     the end of the program }
   ExternalThreads: TThreadList;
+  { this list signals that the ExternalThreads list is cleared and thus the
+    thread instances don't need to remove themselves }
+  ExternalThreadsCleanup: Boolean = False;
 
   { this must be a global var, otherwise unwanted optimizations might happen in
     TThread.SpinWait() }
@@ -135,6 +138,7 @@ type
     procedure Execute; override;
   public
     constructor Create;
+    destructor Destroy; override;
   end;
 
 
@@ -149,6 +153,25 @@ begin
   FExternalThread := True;
   { the parameter is unimportant if FExternalThread is True }
   inherited Create(False);
+  with ExternalThreads.LockList do
+    try
+      Add(Self);
+    finally
+      ExternalThreads.UnlockList;
+    end;
+end;
+
+
+destructor TExternalThread.Destroy;
+begin
+  inherited;
+  if not ExternalThreadsCleanup then
+    with ExternalThreads.LockList do
+      try
+        Extract(Self);
+      finally
+        ExternalThreads.UnlockList;
+      end;
 end;
 
 
@@ -2180,6 +2203,7 @@ begin
   InitHandlerList:=Nil;
   FindGlobalComponentList.Free;
   FindGlobalComponentList:=nil;
+  ExternalThreadsCleanup:=True;
   with ExternalThreads.LockList do
     try
       for i := 0 to Count - 1 do

tests/webtbs/tw27320.pp

@@ -0,0 +1,8 @@
+{ %NORUN }
+
+program tw27320;
+
+uses uw27320.Defaults;
+
+begin
+end.

tests/webtbs/tw27348.pp

@@ -0,0 +1,50 @@
+{ %NORUN }
+
+program tw27348;
+
+{$mode objfpc}
+
+type
+  TRect = record
+    xyz: LongInt;
+  end;
+
+  TControl = class
+  end;
+
+  TWinControl = class(TControl)
+    procedure AlignControls(AControl: TControl; var RemainingClientRect: TRect);
+  end;
+
+  TAlign = (
+    alNone
+  );
+
+{ TWinControl }
+
+procedure TWinControl.AlignControls(AControl: TControl;
+  var RemainingClientRect: TRect);
+
+  procedure DoPosition(Control: TControl; AAlign: TAlign; AControlIndex: Integer);
+
+    function ConstraintHeight(NewHeight: integer): Integer;
+    begin
+      Result:=NewHeight;
+    end;
+
+    procedure ConstraintHeight(var NewTop, NewHeight: integer);
+    begin
+      NewHeight:=ConstraintHeight(NewHeight);
+    end;
+
+  begin
+
+  end;
+
+begin
+
+end;
+
+
+begin
+end.

tests/webtbs/tw27424.pp

@@ -0,0 +1,22 @@
+{ %NORUN }
+
+program tw27424;
+
+{$mode objfpc}
+
+type
+  TType = class(TObject)
+  end;
+
+  generic TTest<T1; T2: TType> = class(TObject)
+  end;
+
+  TFoo = class(TType)
+  end;
+
+  TBar = class(specialize TTest<string, TFoo>)
+  end;
+
+begin
+
+end.

tests/webtbs/tw28271.pp

@@ -0,0 +1,65 @@
+{ %OPT=-gh }
+
+program tw28271;
+
+{$mode delphi}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  Classes
+  { you can add units after this };
+
+type
+  TMyMsgDlg=class
+  private
+    class procedure SyncFree;
+    class procedure SyncCreate;
+  public
+    class procedure StaticCreate;
+    class procedure StaticFree;
+  end;
+
+var
+  Dlg:TMyMsgDlg;
+
+  class procedure TMyMsgDlg.SyncCreate;
+  begin
+    Dlg:=TMyMsgDlg.Create;
+  end;
+
+  class procedure TmyMsgDlg.SyncFree;
+  begin
+    if Assigned(Dlg) then
+    	Dlg.free;
+    Dlg:=nil;
+  end;
+
+  class procedure TMyMsgDlg.StaticCreate;
+  begin
+    if IsLibrary then
+      SyncCreate
+    else
+      TThread.Synchronize(nil,SyncCreate);
+  end;
+
+  class procedure TMyMsgDlg.StaticFree;
+  begin
+    if IsLibrary then
+      SyncFree
+    else
+    begin
+      TThread.Synchronize(nil,SyncFree)
+    end;
+  end;
+
+begin
+  HaltOnNotReleased := True;
+  //writeln('Create');
+  TMyMsgDlg.StaticCreate;
+  //writeln('Free');
+  TMyMsgDlg.StaticFree;
+  //writeln('Done');
+end.
+

tests/webtbs/uw27320.defaults.pp

@@ -0,0 +1,23 @@
+unit uw27320.Defaults;
+
+{$MODE DELPHI}
+
+interface
+
+type
+  IEqualityComparer<T> = interface
+  end;
+
+  TEqualityComparer<T> = class
+  public
+    class function Default: IEqualityComparer<T>; static;
+  end;
+
+implementation
+
+class function TEqualityComparer<T>.Default: IEqualityComparer<T>;
+begin
+end;
+
+end.
+