diff --git a/.gitattributes b/.gitattributes index ad85684eb3..7109a998ae 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/nadd.pas b/compiler/nadd.pas index 5b36920c92..5bff79cc74 100644 --- a/compiler/nadd.pas +++ b/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()=/<>typeinfo() + 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 diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas index 6e88193c17..86fbaed98b 100644 --- a/compiler/ncgld.pas +++ b/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 diff --git a/packages/fcl-json/src/jsonscanner.pp b/packages/fcl-json/src/jsonscanner.pp index ccac0f089a..45ef299ac2 100644 --- a/packages/fcl-json/src/jsonscanner.pp +++ b/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]]); diff --git a/packages/fcl-json/tests/testjsonreader.pp b/packages/fcl-json/tests/testjsonreader.pp index 180f4ef2f6..132dbf4fe0 100644 --- a/packages/fcl-json/tests/testjsonreader.pp +++ b/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 diff --git a/rtl/objpas/classes/classes.inc b/rtl/objpas/classes/classes.inc index 071b9ed56f..42a9d22f97 100644 --- a/rtl/objpas/classes/classes.inc +++ b/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; diff --git a/tests/tbs/tb0678.pp b/tests/tbs/tb0678.pp new file mode 100644 index 0000000000..388f7e6fba --- /dev/null +++ b/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. + diff --git a/tests/webtbs/tw30260.pp b/tests/webtbs/tw30260.pp new file mode 100644 index 0000000000..8951cf887e --- /dev/null +++ b/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.