paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-27 22:13:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

* synchronized with trunk

Browse Source 
git-svn-id: branches/wasm@47010 -
This commit is contained in:
nickysn 2020-09-29 21:12:28 +00:00
commit 23c1ed57d2
8 changed files with 193 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -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

23
compiler/nadd.pas
View File

@ -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

3
compiler/ncgld.pas
View File

@ -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

88
packages/fcl-json/src/jsonscanner.pp
View File

@ -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]]);

11
packages/fcl-json/tests/testjsonreader.pp
View File

@ -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

6
rtl/objpas/classes/classes.inc
View File

@ -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;

72
tests/tbs/tb0678.pp Normal file
View File

@ -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.

21
tests/webtbs/tw30260.pp Normal file
View File

@ -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.