Przeglądaj źródła

* synchronized with trunk

git-svn-id: branches/wasm@48498 -
nickysn 4 lat temu
rodzic
commit
9de09f1d28

+ 39 - 26
packages/fcl-passrc/src/pasresolver.pp

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

+ 5 - 2
packages/fcl-passrc/tests/tcresolver.pas

@@ -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 - 0
packages/pastojs/tests/tcmodules.pas

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

+ 9 - 5
rtl/linux/linux.pp

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

+ 1 - 1
tests/webtbs/uw38429.pp

@@ -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 - 0
utils/fpdoc/dw_chm.pp

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

+ 12 - 5
utils/fpdoc/dw_markdown.pp

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

+ 1 - 1
utils/fpdoc/dwriter.pp

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

+ 2 - 1
utils/fpdoc/fpdoc.pp

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