* synchronized with trunk

git-svn-id: branches/wasm@47010 -

.gitattributes

@@ -13391,6 +13391,7 @@ tests/tbs/tb0675.pp svneol=native#text/pascal
 tests/tbs/tb0676.pp svneol=native#text/pascal
 tests/tbs/tb0676a.pp svneol=native#text/plain
 tests/tbs/tb0677.pp svneol=native#text/pascal
+tests/tbs/tb0678.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain
@@ -18103,6 +18104,7 @@ tests/webtbs/tw30207.pp svneol=native#text/plain
 tests/webtbs/tw30208.pp svneol=native#text/pascal
 tests/webtbs/tw3023.pp svneol=native#text/plain
 tests/webtbs/tw30240.pp svneol=native#text/plain
+tests/webtbs/tw30260.pp svneol=native#text/pascal
 tests/webtbs/tw3028.pp svneol=native#text/plain
 tests/webtbs/tw30299.pp svneol=native#text/plain
 tests/webtbs/tw30310.pp svneol=native#text/plain

compiler/nadd.pas

@@ -490,7 +490,7 @@ implementation
 
 
       var
-        t       , vl, hp: tnode;
+        t,vl,hp,lefttarget,righttarget: tnode;
         lt,rt   : tnodetype;
         hdef,
         rd,ld   , inttype: tdef;
@@ -1309,6 +1309,27 @@ implementation
               end;
           end;
 
+        { check if
+           typeinfo(<type1>)=/<>typeinfo(<type2>)
+          can be evaluated at compile time
+        }
+        lefttarget:=actualtargetnode(@left)^;
+        righttarget:=actualtargetnode(@right)^;
+        if (nodetype in [equaln,unequaln]) and (lefttarget.nodetype=inlinen) and (righttarget.nodetype=inlinen) and
+          (tinlinenode(lefttarget).inlinenumber=in_typeinfo_x) and (tinlinenode(righttarget).inlinenumber=in_typeinfo_x) and
+          (tinlinenode(lefttarget).left.nodetype=typen) and (tinlinenode(righttarget).left.nodetype=typen) then
+          begin
+            case nodetype of
+              equaln:
+                result:=cordconstnode.create(ord(ttypenode(tinlinenode(lefttarget).left).resultdef=ttypenode(tinlinenode(righttarget).left).resultdef),bool8type,false);
+              unequaln:
+                result:=cordconstnode.create(ord(ttypenode(tinlinenode(lefttarget).left).resultdef<>ttypenode(tinlinenode(righttarget).left).resultdef),bool8type,false);
+              else
+                Internalerror(2020092901);
+            end;
+            exit;
+          end;
+
         { slow simplifications }
         if cs_opt_level2 in current_settings.optimizerswitches then
           begin

compiler/ncgld.pas

@@ -882,7 +882,8 @@ implementation
                            ((left.location.size<>right.location.size)
                            { on newer (1993+ :)) x86 cpus, use the fpu to copy extended values }
 {$ifdef x86}
-                            or ({$ifndef x86_64}(current_settings.cputype>=cpu_Pentium) and{$endif x86_64} (is_extended(right.resultdef)))
+                            or ({$ifndef x86_64}(current_settings.cputype>=cpu_Pentium) and{$endif x86_64}
+                            (is_extended(right.resultdef) {$ifdef i386} or is_double(right.resultdef){$endif i386} ))
 {$endif x86}
                            )then
                           begin

packages/fcl-json/src/jsonscanner.pp

@@ -373,8 +373,9 @@ begin
             end
           else if u1<>0 then
             MaybeAppendUnicode;
-          if FTokenStr^ = #0 then
-            Error(SErrOpenString,[FCurRow]);
+          if FTokenStr^ < #$20 then
+            if FTokenStr^ = #0 then Error(SErrOpenString,[FCurRow])
+            else if joStrict in Options then Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
           Inc(FTokenStr);
           end;
         if FTokenStr^ = #0 then
@@ -396,37 +397,54 @@ begin
     '0'..'9','.','-':
       begin
         TokenStart := FTokenStr;
+        if FTokenStr^ = '-' then inc(FTokenStr);
+        case FTokenStr^ of
+          '1'..'9': Inc(FTokenStr);
+          '0': begin
+            Inc(FTokenStr);
+            if (joStrict in Options) and (FTokenStr^ in ['0'..'9']) then
+              Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
+          end;
+          '.': if joStrict in Options then
+                 Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
+          else
+            Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
+        end;
         while true do
         begin
-          Inc(FTokenStr);
           case FTokenStr^ of
+            '0'..'9': inc(FTokenStr);
             '.':
               begin
-                if FTokenStr[1] in ['0'..'9', 'e', 'E'] then
-                begin
-                  Inc(FTokenStr);
-                  repeat
+                case FTokenStr[1] of
+                  '0'..'9': Inc(FTokenStr, 2);
+                  'e', 'E': begin
+                    if joStrict in Options then
+                      Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
                     Inc(FTokenStr);
-                  until not (FTokenStr^ in ['0'..'9', 'e', 'E','-','+']);
+                  end;
+                  else Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
                 end;
-                break;
-              end;
-            '0'..'9': ;
-            'e', 'E':
-              begin
-                Inc(FTokenStr);
-                if FTokenStr^ in ['-','+']  then
-                  Inc(FTokenStr);
                 while FTokenStr^ in ['0'..'9'] do
-                  Inc(FTokenStr);
+                  inc(FTokenStr);
                 break;
               end;
           else
-            if {(FTokenStr<>FEOL) and }not (FTokenStr^ in [#13,#10,#0,'}',']',',',#9,' ']) then
-               Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
             break;
           end;
         end;
+        if FTokenStr^ in ['e', 'E'] then begin
+          Inc(FTokenStr);
+          if FTokenStr^ in ['-','+']  then
+            Inc(FTokenStr);
+          if not (FTokenStr^ in ['0'..'9']) then
+            Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
+          repeat
+            Inc(FTokenStr);
+          until not (FTokenStr^ in ['0'..'9']);
+        end;
+        if {(FTokenStr<>FEOL) and }not (FTokenStr^ in [#13,#10,#0,'}',']',',',#9,' ']) then
+          Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
         SectionLength := FTokenStr - TokenStart;
         FCurTokenString:='';
         SetString(FCurTokenString, TokenStart, SectionLength);
@@ -513,23 +531,33 @@ begin
         tstart:=CurRow;
         Tcol:=CurColumn;
         TokenStart := FTokenStr;
+        Result:=tkIdentifier;
+        case TokenStart^ of
+          't': if (TokenStart[1] = 'r') and (TokenStart[2] = 'u') and (TokenStart[3] = 'e') then
+            Result:=tkTrue;
+          'f': if (TokenStart[1] = 'a') and (TokenStart[2] = 'l') and (TokenStart[3] = 's') and (TokenStart[4] = 'e') then
+            Result:=tkFalse;
+          'n': if (TokenStart[1] = 'u') and (TokenStart[2] = 'l') and (TokenStart[3] = 'l') then
+            Result:=tkNull;
+        end;
+        if result <> tkIdentifier then inc(FTokenStr, length(TokenInfos[result]) - 1);
         repeat
           Inc(FTokenStr);
         until not (FTokenStr^ in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
         SectionLength := FTokenStr - TokenStart;
         FCurTokenString:='';
         SetString(FCurTokenString, TokenStart, SectionLength);
-        for it := tkTrue to tkNull do
-          if CompareText(CurTokenString, TokenInfos[it]) = 0 then
-            begin
-            Result := it;
-            FCurToken := Result;
-            exit;
-            end;
-        if (joStrict in Options) then
-          Error(SErrInvalidCharacter, [tStart,tcol,TokenStart[0]])
-        else
-          Result:=tkIdentifier;
+        if (result = tkIdentifier) or (SectionLength <> length(TokenInfos[result])) then begin
+          if (joStrict in Options) then
+            Error(SErrInvalidCharacter, [tStart,tcol,TokenStart[0]]);
+          for it := tkTrue to tkNull do
+            if CompareText(CurTokenString, TokenInfos[it]) = 0 then
+              begin
+              Result := it;
+              FCurToken := Result;
+              exit;
+              end;
+        end;
       end;
   else
     Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);

packages/fcl-json/tests/testjsonreader.pp

@@ -42,6 +42,8 @@ type
 
   { TTestReader }
 
+  { TBaseTestReader }
+
   TBaseTestReader = class(TTestJSON)
   private
     FOptions : TJSONOptions;
@@ -60,6 +62,7 @@ type
     procedure TestTrue;
     procedure TestFalse;
     procedure TestFloat;
+    procedure TestFloatError;
     procedure TestInteger;
     procedure TestInt64;
     procedure TestString;
@@ -299,6 +302,14 @@ begin
   DoTestFloat(0,'0.0');
 end;
 
+procedure TBaseTestReader.TestFloatError;
+begin
+  DoTestError('.12',[joStrict]);
+  DoTestError('.12E',[]);
+  DoTestError('0.12E+',[]);
+  DoTestError('.12E+-1',[]);
+end;
+
 procedure TBaseTestReader.TestString;
 
 begin

rtl/objpas/classes/classes.inc

@@ -609,7 +609,11 @@ begin
         Continue;
       end;
       { then check for the method }
-      if Assigned(aMethod) and (entry^.Method <> aMethod) then begin
+      if Assigned(aMethod) and
+          (
+            (TMethod(entry^.Method).Code <> TMethod(aMethod).Code) or
+            (TMethod(entry^.Method).Data <> TMethod(aMethod).Data)
+          ) then begin
         lastentry := entry;
         entry := entry^.Next;
         Continue;

tests/tbs/tb0678.pp

@@ -0,0 +1,72 @@
+{%skiptarget=$nothread }
+
+program tqueue;
+
+{$mode objfpc}
+
+uses
+{$ifdef unix}
+  cthreads,
+{$endif}
+  SysUtils, Classes;
+
+type
+  TTest = class
+    procedure DoTest;
+  end;
+
+  TTestThread = class(TThread)
+  protected
+    procedure Execute; override;
+  end;
+
+var
+  count: LongInt = 0;
+
+procedure TTest.DoTest;
+begin
+  Inc(count);
+end;
+
+var
+  t1, t2: TTest;
+
+procedure TTestThread.Execute;
+var
+  method: TMethod;
+begin
+  Queue(@t1.DoTest);
+  Queue(@t2.DoTest);
+
+  { should remove nothing }
+  method.Code := @TTest.DoTest;
+  method.Data := Nil;
+
+  RemoveQueuedEvents(TThreadMethod(method));
+
+  { should remove only one }
+  RemoveQueuedEvents(@t1.DoTest);
+end;
+
+var
+  t: TTestThread;
+begin
+  t := TTestThread.Create(True);
+  try
+    t1 := TTest.Create;
+    t2 := TTest.Create;
+
+    t.Start;
+    t.WaitFor;
+
+    CheckSynchronize;
+
+    if count <> 1 then
+      Halt(1);
+  finally
+    t1.Free;
+    t2.Free;
+    t.Free;
+  end;
+end.
+

tests/webtbs/tw30260.pp

@@ -0,0 +1,21 @@
+program test;
+
+// {$mode ObjFPC}
+{$mode Delphi}
+//{$mode DelphiUnicode}
+
+const
+  b1 = TypeInfo(String)=TypeInfo(RawByteString);
+  b2 = TypeInfo(NativeInt)=TypeInfo(NativeInt);
+
+begin
+  if TypeInfo(String)=TypeInfo(RawByteString) then
+    writeln('equal')
+  else
+    writeln('not equal');
+
+  if TypeInfo(NativeInt)=TypeInfo(NativeInt) then
+    writeln('equal')
+  else
+    writeln('not equal');
+end.