paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-10 04:49:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* synchronized with trunk

Browse Source 
git-svn-id: branches/wasm@48498 -
This commit is contained in:
nickysn 2021-02-02 04:02:02 +00:00
commit 9de09f1d28
9 changed files with 111 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
packages/fcl-passrc/src/pasresolver.pp
View File

@ -18763,54 +18763,67 @@ function TPasResolver.BI_InExclude_OnGetCallCompatibility(
// check params of built in proc 'include'
var
Params: TParamsExpr;
Param: TPasExpr;
ParamResolved: TPasResolverResult;
Param0, Param1: TPasExpr;
Param0Resolved, Param1Resolved: TPasResolverResult;
EnumType: TPasEnumType;
C: TClass;
LoTypeEl: TPasType;
RgType: TPasRangeType;
begin
if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
exit(cIncompatible);
Params:=TParamsExpr(Expr);
// first param: set variable
// first Param0: set variable
// todo set of int, set of char, set of bool
Param:=Params.Params[0];
ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
Param0:=Params.Params[0];
ComputeElement(Param0,Param0Resolved,[rcNoImplicitProc]);
Param1:=Params.Params[1];
ComputeElement(Param1,Param1Resolved,[]);
EnumType:=nil;
if ([rrfReadable,rrfWritable]*ParamResolved.Flags=[rrfReadable,rrfWritable])
and (ParamResolved.IdentEl<>nil) then
RgType:=nil;
if ([rrfReadable,rrfWritable]*Param0Resolved.Flags=[rrfReadable,rrfWritable])
and (Param0Resolved.IdentEl<>nil) then
begin
C:=ParamResolved.IdentEl.ClassType;
C:=Param0Resolved.IdentEl.ClassType;
if (C.InheritsFrom(TPasVariable)
or (C=TPasArgument)
or (C=TPasResultElement)) then
begin
if (ParamResolved.BaseType=btSet)
and (ParamResolved.LoTypeEl is TPasEnumType) then
EnumType:=TPasEnumType(ParamResolved.LoTypeEl);
if Param0Resolved.BaseType=btSet then
begin
LoTypeEl:=Param0Resolved.LoTypeEl;
if LoTypeEl.ClassType=TPasEnumType then
begin
EnumType:=TPasEnumType(LoTypeEl);
if (not (rrfReadable in Param0Resolved.Flags))
or (Param0Resolved.LoTypeEl<>EnumType) then
begin
if RaiseOnError then
RaiseIncompatibleType(20210201225926,nIncompatibleTypeArgNo,
['2'],Param0Resolved.LoTypeEl,EnumType,Param0);
exit(cIncompatible);
end;
end
else if LoTypeEl.ClassType=TPasRangeType then
begin
RgType:=TPasRangeType(LoTypeEl);
ComputeElement(RgType.RangeExpr.left,Param0Resolved,[]);
Result:=CheckAssignResCompatibility(Param0Resolved,Param1Resolved,Param1,RaiseOnError);
end;
end;
end;
end;
if EnumType=nil then
if (EnumType=nil) and (RgType=nil) then
begin
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.OnGetCallCompatibility_InExclude ',GetResolverResultDbg(ParamResolved));
writeln('TPasResolver.OnGetCallCompatibility_InExclude ',GetResolverResultDbg(Param0Resolved));
{$ENDIF}
exit(CheckRaiseTypeArgNo(20170216152301,1,Param,ParamResolved,
exit(CheckRaiseTypeArgNo(20170216152301,1,Param0,Param0Resolved,
'variable of set of enumtype',RaiseOnError));
end;
// second param: enum
Param:=Params.Params[1];
ComputeElement(Param,ParamResolved,[]);
if (not (rrfReadable in ParamResolved.Flags))
or (ParamResolved.LoTypeEl<>EnumType) then
begin
if RaiseOnError then
RaiseIncompatibleType(20170216152302,nIncompatibleTypeArgNo,
['2'],ParamResolved.LoTypeEl,EnumType,Param);
exit(cIncompatible);
end;
Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
end;

7
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -3360,7 +3360,8 @@ begin
'begin',
' i:=i2;',
' if i=i2 then ;',
' i:=ord(i);']);
' i:=ord(i);',
'']);
ParseProgram;
CheckResolverUnexpectedHints;
end;
@ -4232,7 +4233,9 @@ begin
' s:= {#s3_set}[3..4];',
' s:= {#s4_set}[Three];',
' if 3 in a then ;',
' s:=c;']);
' s:=c;',
' Include(s,3);',
'']);
ParseProgram;
CheckParamsExpr_pkSet_Markers;
CheckResolverUnexpectedHints;

39
packages/pastojs/tests/tcmodules.pas
View File

@ -389,6 +389,7 @@ type
Procedure TestSet_Property;
Procedure TestSet_EnumConst;
Procedure TestSet_IntConst;
Procedure TestSet_IntRange;
Procedure TestSet_AnonymousEnumType;
Procedure TestSet_AnonymousEnumTypeChar; // ToDo
Procedure TestSet_ConstEnum;
@ -6420,6 +6421,44 @@ begin
'']));
end;
procedure TTestModule.TestSet_IntRange;
begin
StartProgram(false);
Add([
'type',
' TRange = 1..3;',
' TEnums = set of TRange;',
'const',
' Orange = 2;',
'var',
' Enum: byte;',
' Enums: TEnums;',
'begin',
' Enums:=[];',
' Enums:=[1];',
' Enums:=[2..3];',
' Include(enums,orange);',
' Exclude(enums,orange);',
' if orange in enums then;',
' if orange in [orange,1] then;']);
ConvertProgram;
CheckSource('TestSet_IntRange',
LinesToStr([ // statements
'this.Orange = 2;',
'this.Enum = 0;',
'this.Enums = {};',
'']),
LinesToStr([
'$mod.Enums = {};',
'$mod.Enums = rtl.createSet(1);',
'$mod.Enums = rtl.createSet(null, 2, 3);',
'$mod.Enums = rtl.includeSet($mod.Enums, 2);',
'$mod.Enums = rtl.excludeSet($mod.Enums, 2);',
'if (2 in $mod.Enums) ;',
'if (2 in rtl.createSet(2, 1)) ;',
'']));
end;
procedure TTestModule.TestSet_AnonymousEnumType;
begin
StartProgram(false);

14
rtl/linux/linux.pp
View File

@ -20,7 +20,7 @@ unit Linux;
{$i osdefs.inc}
{$packrecords c}
{$ifdef FPC_USE_LIBC}
{$ifdef FPC_USE_LIBC}
{$linklib rt} // for clock* functions
{$endif}
@ -40,7 +40,7 @@ type
__s32 = Longint;
__u64 = QWord;
__s64 = Int64;
type
TSysInfo = record
uptime: clong; //* Seconds since boot */
@ -483,8 +483,8 @@ Type
function clock_getres(clk_id : clockid_t; res : ptimespec) : cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'clock_getres'; {$ENDIF}
function clock_gettime(clk_id : clockid_t; tp: ptimespec) : cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'clock_gettime'; {$ENDIF}
function clock_settime(clk_id : clockid_t; tp : ptimespec) : cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'clock_settime'; {$ENDIF}
function setregid(rgid,egid : uid_t): cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'setregid'; {$ENDIF}
function setreuid(ruid,euid : uid_t): cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'setreuid'; {$ENDIF}
function setregid(rgid,egid : uid_t): cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'setregid'; {$ENDIF}
function setreuid(ruid,euid : uid_t): cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'setreuid'; {$ENDIF}
Const
STATX_TYPE = $00000001;
@ -555,8 +555,10 @@ Type
tkernel_timespecs = array[0..1] of kernel_timespec;
{$ifndef android}
Function utimensat(dfd: cint; path:pchar;const times:tkernel_timespecs;flags:cint):cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'statx'; {$ENDIF}
Function futimens(fd: cint; const times:tkernel_timespecs):cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'futimens'; {$ENDIF}
{$endif android}
implementation
@ -861,7 +863,7 @@ function setregid(rgid,egid : uid_t): cint;
begin
setregid:=do_syscall(syscall_nr_setregid,rgid,egid);
end;
function setreuid(ruid,euid : uid_t): cint;
begin
setreuid:=do_syscall(syscall_nr_setreuid,ruid,euid);
@ -875,6 +877,7 @@ end;
{$endif}
{$ifndef android}
Function utimensat(dfd: cint; path:pchar;const times:tkernel_timespecs;flags:cint):cint;
var
tsa: Array[0..1] of timespec;
@ -913,6 +916,7 @@ begin
futimens:=do_syscall(syscall_nr_utimensat,fd,TSysParam(nil),TSysParam(@times),0);
{$endif sizeof(clong)<=4}
end;
{$endif android}
end.

2
tests/webtbs/uw38429.pp
View File

@ -11,7 +11,7 @@ uses
type
TMyVar = packed record
VType: TVarType;
Dummy1: array[0..Pred(SizeOf(Pointer) - 2)] of Byte;
Dummy1: array[0..2] of Word;
Dummy2,
Dummy3: Pointer;
procedure Init;

3
utils/fpdoc/dw_chm.pp
View File

@ -1,5 +1,8 @@
unit dw_chm;
{$mode objfpc}
{$h+}
interface
uses Classes, DOM,

17
utils/fpdoc/dw_markdown.pp
View File

@ -1473,12 +1473,19 @@ begin
if aEL.ExternalName<>'' then
aLine:=aLine+' external name '''+ael.ExternalName+'''';
if Assigned(aEL.AncestorType) then
if (aEL.AncestorType is TPasSpecializeType) then
begin
aLine:=aLine+' ('+ael.AncestorType.Name;
if Assigned(ael.Interfaces) and (aEl.Interfaces.Count>0) then
For I:=0 to aEl.Interfaces.Count-1 do
aLine:=aLine+', '+TPasElement(aEl.Interfaces[i]).Name;
aLine:=aLine+')';
aLine:=aLine+'(specialize ';
aLine:=aLine+ TPasSpecializeType(aEL.AncestorType).DestType.Name;
aLine:=aLine+ '<,>)';
end
else
begin
aLine:=aLine+' ('+ael.AncestorType.Name;
if Assigned(ael.Interfaces) and (aEl.Interfaces.Count>0) then
For I:=0 to aEl.Interfaces.Count-1 do
aLine:=aLine+', '+TPasElement(aEl.Interfaces[i]).Name;
aLine:=aLine+')';
end;
if Assigned(aEl.GUIDExpr) then
aLine:=aLine+' ['+aEl.GUIDExpr.GetDeclaration(True)+']';

2
utils/fpdoc/dwriter.pp
View File

@ -1621,7 +1621,7 @@ end;
procedure TFPDocWriter.OutputResults();
begin
DoLog('Documentation process finished.');
DoLog('Package: %s - Documentation process finished.', [FPackage.Name]);
end;
function TFPDocWriter.ConvertExtShort(AContext: TPasElement;

3
utils/fpdoc/fpdoc.pp
View File

@ -14,7 +14,8 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
{$mode objfpc}
{$h+}
program FPDoc;
uses