* synchronized with trunk

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

.gitattributes

@@ -5365,7 +5365,7 @@ packages/graph/src/inc/clip.inc svneol=native#text/plain
 packages/graph/src/inc/fills.inc svneol=native#text/plain
 packages/graph/src/inc/fontdata.inc svneol=native#text/plain
 packages/graph/src/inc/graph.inc svneol=native#text/plain
-packages/graph/src/inc/graph.tex -text
+packages/graph/src/inc/graph.tex svneol=native#text/plain
 packages/graph/src/inc/graphh.inc svneol=native#text/plain
 packages/graph/src/inc/gtext.inc svneol=native#text/plain
 packages/graph/src/inc/makefile.inc svneol=native#text/plain
@@ -14046,6 +14046,7 @@ tests/test/cg/tobjsize.pp svneol=native#text/plain
 tests/test/cg/tpara1.pp svneol=native#text/plain
 tests/test/cg/tpara2.pp svneol=native#text/plain
 tests/test/cg/tpara3.pp svneol=native#text/plain
+tests/test/cg/tpara4.pp svneol=native#text/pascal
 tests/test/cg/tprintf.pp svneol=native#text/plain
 tests/test/cg/tprintf2.pp svneol=native#text/plain
 tests/test/cg/tprintf3.pp svneol=native#text/plain
@@ -16174,7 +16175,9 @@ tests/test/units/fpwidestring/twide6fpwidestring.pp svneol=native#text/pascal
 tests/test/units/fpwidestring/twide7fpwidestring.pp svneol=native#text/pascal
 tests/test/units/lineinfo/tlininfo.pp svneol=native#text/plain
 tests/test/units/linux/tepoll1.pp svneol=native#text/pascal
+tests/test/units/linux/tfutimesen.pp svneol=native#text/pascal
 tests/test/units/linux/tstatx.pp svneol=native#text/pascal
+tests/test/units/linux/tutimensat.pp svneol=native#text/pascal
 tests/test/units/math/tcmpnan.pp svneol=native#text/plain
 tests/test/units/math/tdivmod.pp svneol=native#text/plain
 tests/test/units/math/tmask.inc svneol=native#text/plain
@@ -18718,6 +18721,7 @@ tests/webtbs/tw3840.pp svneol=native#text/plain
 tests/webtbs/tw3841.pp svneol=native#text/plain
 tests/webtbs/tw38412.pp svneol=native#text/pascal
 tests/webtbs/tw38413.pp svneol=native#text/pascal
+tests/webtbs/tw38429.pp svneol=native#text/pascal
 tests/webtbs/tw3863.pp svneol=native#text/plain
 tests/webtbs/tw3864.pp svneol=native#text/plain
 tests/webtbs/tw3865.pp svneol=native#text/plain
@@ -19255,6 +19259,7 @@ tests/webtbs/uw38069.pp svneol=native#text/pascal
 tests/webtbs/uw38385a.pp svneol=native#text/pascal
 tests/webtbs/uw38385b.pp svneol=native#text/pascal
 tests/webtbs/uw38385c.pp svneol=native#text/pascal
+tests/webtbs/uw38429.pp svneol=native#text/pascal
 tests/webtbs/uw3968.pp svneol=native#text/plain
 tests/webtbs/uw4056.pp svneol=native#text/plain
 tests/webtbs/uw4140.pp svneol=native#text/plain

compiler/nmem.pas

@@ -938,6 +938,7 @@ implementation
          htype,elementdef,elementptrdef : tdef;
          newordtyp: tordtype;
          valid : boolean;
+         minvalue, maxvalue: Tconstexprint;
       begin
          result:=nil;
          typecheckpass(left);
@@ -1054,10 +1055,19 @@ implementation
                         begin
                           { in case of an integer type, we need a new type which covers declaration range and index range,
                             see tests/webtbs/tw38413.pp
+
+                            This matters only if we sign extend, if the type exceeds the sint range, we can fall back only
+                            to the index type
                           }
-                          if is_integer(right.resultdef) then
+                          if is_integer(right.resultdef) and ((torddef(right.resultdef).low<0) or (TConstExprInt(Tarraydef(left.resultdef).lowrange)<0)) then
-                            newordtyp:=range_to_basetype(min(TConstExprInt(Tarraydef(left.resultdef).lowrange),torddef(right.resultdef).low),
+                            begin
-                              max(TConstExprInt(Tarraydef(left.resultdef).highrange),torddef(right.resultdef).high))
+                              minvalue:=min(TConstExprInt(Tarraydef(left.resultdef).lowrange),torddef(right.resultdef).low);
+                              maxvalue:=max(TConstExprInt(Tarraydef(left.resultdef).highrange),torddef(right.resultdef).high);
+                              if maxvalue>torddef(sinttype).high then
+                                newordtyp:=Torddef(right.resultdef).ordtype
+                              else
+                                newordtyp:=range_to_basetype(minvalue,maxvalue);
+                            end
                           else
                             newordtyp:=Torddef(right.resultdef).ordtype;
                         end

packages/rtl-objpas/src/inc/variants.pp

@@ -2351,10 +2351,14 @@ begin
 end;
 
 procedure DoVarCast(var aDest : TVarData; const aSource : TVarData; aVarType : LongInt);
+var
+  Handler: TCustomVariantType;
 begin
   with aSource do
     if vType = aVarType then
       DoVarCopy(aDest, aSource)
+    else if FindCustomVariantType(vType, Handler) then
+      Handler.CastTo(aDest, aSource, aVarType)
     else begin
       if (vType = varNull) and NullStrictConvert then
         VarCastError(varNull, aVarType);

rtl/linux/linux.pp

@@ -517,7 +517,7 @@ Type
   end;
   pstatx_timestamp = ^statx_timestamp;
 
-  statx = record
+  tstatx = record
     stx_mask : __u32;
     stx_blksize : __u32;
     stx_attributes : __u64;
@@ -540,9 +540,23 @@ Type
     stx_dev_minor : __u32;
     __spare2 : array[0..13] of __u64;
   end;
-  pstatx = ^statx;
+  pstatx = ^tstatx;
 
-  function Fpstatx(dfd: cint; filename: pchar; flags,mask: cuint; var buf: statx):cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'statx'; {$ENDIF}
+  function statx(dfd: cint; filename: pchar; flags,mask: cuint; var buf: tstatx):cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'statx'; {$ENDIF}
+
+Type
+   kernel_time64_t = clonglong;
+
+   kernel_timespec = record
+     tv_sec  : kernel_time64_t;
+     tv_nsec : clonglong;
+   end;
+   pkernel_timespec = ^kernel_timespec;
+
+   tkernel_timespecs = array[0..1] of kernel_timespec;
+
+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}
 
 implementation
 
@@ -854,11 +868,51 @@ begin
 end;
 
 
-function Fpstatx(dfd: cint; filename: pchar; flags,mask: cuint; var buf: statx):cint;
+function statx(dfd: cint; filename: pchar; flags,mask: cuint; var buf: tstatx):cint;
 begin
-  Fpstatx:=do_syscall(syscall_nr_statx,TSysParam(dfd),TSysParam(filename),TSysParam(flags),TSysParam(mask),TSysParam(@buf));
+  statx:=do_syscall(syscall_nr_statx,TSysParam(dfd),TSysParam(filename),TSysParam(flags),TSysParam(mask),TSysParam(@buf));
 end;
 
 {$endif}
 
+Function utimensat(dfd: cint; path:pchar;const times:tkernel_timespecs;flags:cint):cint;
+var
+  tsa: Array[0..1] of timespec;
+begin
+{$if sizeof(clong)<=4}
+  utimensat:=do_syscall(syscall_nr_utimensat_time64,dfd,TSysParam(path),TSysParam(@times),0);
+  if (utimensat>=0) or (fpgeterrno<>ESysENOSYS) then
+    exit;
+  { try 32 bit fall back }
+  tsa[0].tv_sec := times[0].tv_sec;
+  tsa[0].tv_nsec := times[0].tv_nsec;
+  tsa[1].tv_sec := times[1].tv_sec;
+  tsa[1].tv_nsec := times[1].tv_nsec;
+  utimensat:=do_syscall(syscall_nr_utimensat,dfd,TSysParam(path),TSysParam(@tsa),0);
+{$else sizeof(clong)<=4}
+  utimensat:=do_syscall(syscall_nr_utimensat,dfd,TSysParam(path),TSysParam(@times),0);
+{$endif sizeof(clong)<=4}
+end;
+
+
+Function futimens(fd: cint; const times:tkernel_timespecs):cint;
+var
+  tsa: Array[0..1] of timespec;
+begin
+{$if sizeof(clong)<=4}
+  futimens:=do_syscall(syscall_nr_utimensat_time64,fd,TSysParam(nil),TSysParam(@times),0);
+  if (futimens>=0) or (fpgeterrno<>ESysENOSYS) then
+    exit;
+  { try 32 bit fall back }
+  tsa[0].tv_sec := times[0].tv_sec;
+  tsa[0].tv_nsec := times[0].tv_nsec;
+  tsa[1].tv_sec := times[1].tv_sec;
+  tsa[1].tv_nsec := times[1].tv_nsec;
+  futimens:=do_syscall(syscall_nr_utimensat,fd,TSysParam(nil),TSysParam(@tsa),0);
+{$else sizeof(clong)<=4}
+  futimens:=do_syscall(syscall_nr_utimensat,fd,TSysParam(nil),TSysParam(@times),0);
+{$endif sizeof(clong)<=4}
+end;
+
 end.
+

rtl/unix/sysutils.pp

@@ -56,7 +56,12 @@ uses
 {$ENDIF}
 
 {$if defined(LINUX)}
-{$DEFINE HAS_STATX}
+  {$if sizeof(clong)<8}
+    {$DEFINE USE_STATX}
+    {$DEFINE USE_UTIMENSAT}
+  {$endif sizeof(clong)<=4}
+
+  {$DEFINE USE_FUTIMES}
 {$endif}
 
 { Include platform independent interface part }
@@ -556,20 +561,20 @@ Function FileAge (Const FileName : RawByteString): Int64;
 Var
   Info : Stat;
   SystemFileName: RawByteString;
-{$ifdef HAS_STATX}
+{$ifdef USE_STATX}
-  Infox : Statx;
+  Infox : TStatx;
-{$endif HAS_STATX}
+{$endif USE_STATX}
 begin
   SystemFileName:=ToSingleByteFileSystemEncodedFileName(FileName);
 
-{$ifdef HAS_STATX}
+{$ifdef USE_STATX}
   { first try statx }
-  if (Fpstatx(0,pchar(SystemFileName),0,STATX_MTIME or STATX_MODE,Infox)>=0) and not(fpS_ISDIR(Infox.stx_mode)) then
+  if (statx(0,pchar(SystemFileName),0,STATX_MTIME or STATX_MODE,Infox)>=0) and not(fpS_ISDIR(Infox.stx_mode)) then
     begin
       Result:=Infox.stx_mtime.tv_sec;
       exit;
     end;
-{$endif HAS_STATX}
+{$endif USE_STATX}
 
   If  (fpstat(pchar(SystemFileName),Info)<0) or fpS_ISDIR(info.st_mode) then
     exit(-1)
@@ -605,6 +610,36 @@ begin
 end;
 
 
+{$ifdef USE_STATX}
+Function LinuxToWinAttr (const FN : RawByteString; Const Info : TStatx) : Longint;
+Var
+  LinkInfo : Stat;
+  nm : RawByteString;
+begin
+  Result:=faArchive;
+  If fpS_ISDIR(Info.stx_mode) then
+    Result:=Result or faDirectory;
+  nm:=ExtractFileName(FN);
+  If (Length(nm)>=2) and
+     (nm[1]='.') and
+     (nm[2]<>'.')  then
+    Result:=Result or faHidden;
+  If (Info.stx_Mode and S_IWUSR)=0 Then
+     Result:=Result or faReadOnly;
+  If fpS_ISSOCK(Info.stx_mode) or fpS_ISBLK(Info.stx_mode) or fpS_ISCHR(Info.stx_mode) or fpS_ISFIFO(Info.stx_mode) Then
+     Result:=Result or faSysFile;
+  If fpS_ISLNK(Info.stx_mode) Then
+    begin
+      Result:=Result or faSymLink;
+      // Windows reports if the link points to a directory.
+      { as we are only interested in the st_mode field here, we do not need to use statx }
+      if (fpstat(pchar(FN),LinkInfo)>=0) and fpS_ISDIR(LinkInfo.st_mode) then
+        Result := Result or faDirectory;
+    end;
+end;
+{$endif USE_STATX}
+
+
 function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
 var
   Info : Stat;
@@ -892,8 +927,35 @@ end;
 
 Function FindGetFileInfo(const s: RawByteString; var f: TAbstractSearchRec; var Name: RawByteString):boolean;
 Var
+{$ifdef USE_STATX}
+  stx : linux.tstatx;
+{$endif USE_STATX}
   st : baseunix.stat;
   WinAttr : longint;
+begin
+{$ifdef USE_STATX}
+  if Assigned(f.FindHandle) and ( (PUnixFindData(F.FindHandle)^.searchattr and faSymlink) > 0) then
+    FindGetFileInfo:=statx(AT_FDCWD,pointer(s),AT_SYMLINK_NOFOLLOW,STATX_ALL,stx)=0
+  else
+    FindGetFileInfo:=statx(AT_FDCWD,pointer(s),0,STATX_ALL,stx)=0;
+  if FindGetFileInfo then
+    begin
+      WinAttr:=LinuxToWinAttr(s,stx);
+      FindGetFileInfo:=(WinAttr and Not(PUnixFindData(f.FindHandle)^.searchattr))=0;
+
+      if FindGetFileInfo then
+        begin
+          Name:=ExtractFileName(s);
+          f.Attr:=WinAttr;
+          f.Size:=stx.stx_Size;
+          f.Mode:=stx.stx_mode;
+          f.Time:=stx.stx_mtime.tv_sec;
+          FindGetFileInfo:=true;
+        end;
+    end
+  { no statx? try stat }
+  else if fpgeterrno=ESysENOSYS then
+{$endif USE_STATX}
     begin
       if Assigned(f.FindHandle) and ( (PUnixFindData(F.FindHandle)^.searchattr and faSymlink) > 0) then
         FindGetFileInfo:=(fplstat(pointer(s),st)=0)
@@ -914,6 +976,7 @@ begin
           FindGetFileInfo:=true;
         end;
     end;
+end;
 
 
 // Returns the FOUND filename. Error code <> 0 if no file found
@@ -1014,22 +1077,42 @@ End;
 
 
 Function FileGetDate (Handle : Longint) : Int64;
-
+Var
-Var Info : Stat;
+  Info : Stat;
-
+{$ifdef USE_STATX}
+  Infox : TStatx;
+{$endif USE_STATX}
 begin
-  If (fpFStat(Handle,Info))<0 then
+  Result:=-1;
-    Result:=-1
+{$ifdef USE_STATX}
-  else
+  if statx(Handle,nil,0,STATX_MTIME,Infox)=0 then
+    Result:=Infox.stx_Mtime.tv_sec
+  else if fpgeterrno=ESysENOSYS then
+{$endif USE_STATX}
+    begin
+      If fpFStat(Handle,Info)=0 then
         Result:=Info.st_Mtime;
     end;
+end;
 
 
 Function FileSetDate (Handle : Longint;Age : Int64) : Longint;
-
+{$ifdef USE_FUTIMES}
+var
+  times : tkernel_timespecs;
+{$endif USE_FUTIMES}
 begin
-  // Impossible under Linux from FileHandle !!
+  Result:=0;
+{$ifdef USE_FUTIMES}
+  times[0].tv_sec:=Age;
+  times[0].tv_nsec:=0;
+  times[1].tv_sec:=Age;
+  times[1].tv_nsec:=0;
+  if futimens(Handle,times) = -1 then
+    Result:=fpgeterrno;
+{$else USE_FUTIMES}
   FileSetDate:=-1;
+{$endif USE_FUTIMES}
 end;
 
 
@@ -1086,14 +1169,29 @@ end;
 Function FileSetDate (Const FileName : RawByteString; Age : Int64) : Longint;
 var
   SystemFileName: RawByteString;
+{$ifdef USE_UTIMENSAT}
+  times : tkernel_timespecs;
+{$endif USE_UTIMENSAT}
   t: TUTimBuf;
 begin
   SystemFileName:=ToSingleByteFileSystemEncodedFileName(FileName);
   Result:=0;
+{$ifdef USE_UTIMENSAT}
+  times[0].tv_sec:=Age;
+  times[0].tv_nsec:=0;
+  times[1].tv_sec:=Age;
+  times[1].tv_nsec:=0;
+  if utimensat(AT_FDCWD,PChar(SystemFileName),times,0) = -1 then
+    Result:=fpgeterrno;
+  if fpgeterrno=ESysENOSYS then
+{$endif USE_UTIMENSAT}
+    begin
+      Result:=0;
       t.actime:= Age;
       t.modtime:=Age;
       if fputime(PChar(SystemFileName), @t) = -1 then
         Result:=fpgeterrno;
+    end
 end;
 
 {****************************************************************************

tests/test/cg/tpara4.pp

@@ -0,0 +1,22 @@
+{ This test ensures that a "const TVarData" parameter is passed as a reference.
+  This is required for Delphi compatibility as implementers of IVarInvokable or
+  inheritors of TInvokableVariantType need to modify the variant data by using
+  a pointer to the TVarData because it's passed as const and thus not modifyable
+  by itself.
+  This behavior is documented in so far as the C++ builder documentation shows
+  that the same parameter is implemented as "const&". }
+
+program tpara4;
+
+var
+  d: TVarData;
+
+procedure Test(const v: TVarData);
+begin
+  if @d <> @v then
+    Halt(1);
+end;
+
+begin
+  Test(d);
+end.

tests/test/units/linux/tfutimesen.pp

@@ -0,0 +1,84 @@
+{ %target=linux }
+uses
+  ctypes,baseunix,linux;
+
+var
+  un : utsname;
+  res : cint;
+  f1,f2 : text;
+  err : word;
+  mystatx1,mystatx2 : tstatx;
+  times : tkernel_timespecs;
+  st,major,minor : string;
+  i,p,e : longint;
+  major_release, minor_release : longint;
+begin
+  fpuname(un);
+  st:=un.release;
+  for i:=1 to UTSNAME_LENGTH do
+    if st[i]='.' then
+      begin
+        p:=i;
+        major:=system.copy(st,1,p-1);
+        system.val(major,major_release,err);
+        if err<>0 then
+          begin
+            writeln('Unable to parse first part of linux version ',st,'(',major,') correctly');
+            halt(2);
+          end;
+        break;
+      end;
+
+  for i:=p+1 to UTSNAME_LENGTH do
+    if st[i]='.' then
+      begin
+        e:=i;
+        minor:=system.copy(st,p+1,e-p-1);
+        system.val(minor,minor_release,err);
+        if err<>0 then
+          begin
+            writeln('Unable to second part of parse linux version ',st,'i(',minor,') correctly');
+            halt(2);
+          end;
+        break;
+      end;
+  if (major_release<4) or ((major_release=4) and (minor_release<11)) then
+    begin
+      writeln('This version of Linux: ',st,' does not have fstatx syscall');
+      halt(0);
+    end
+  else
+    writeln('This linux version ',st,' should support statx syscall');
+
+  assign(f1,'tutimensat1.txt');
+  rewrite(f1);
+  write(f1,'ccccc');
+  assign(f2,'tutimensat2.txt');
+  rewrite(f2);
+  write(f2,'ccccc');
+
+  res:=statx(AT_FDCWD,'tutimensat1.txt',AT_SYMLINK_NOFOLLOW,STATX_ALL,mystatx1);
+  if res<>0 then
+    halt(1);
+  times[0].tv_sec:=mystatx1.stx_atime.tv_sec;
+  times[0].tv_nsec:=mystatx1.stx_atime.tv_nsec;
+  times[1].tv_sec:=mystatx1.stx_mtime.tv_sec;
+  times[1].tv_nsec:=mystatx1.stx_mtime.tv_nsec;
+  res:=futimens(textrec(f2).handle,times);
+  if res<>0 then
+    halt(1);
+  res:=statx(AT_FDCWD,'tutimensat2.txt',AT_SYMLINK_NOFOLLOW,STATX_ALL,mystatx2);
+  if res<>0 then
+    halt(1);
+
+  close(f1);
+  close(f2);
+
+  erase(f1);
+  erase(f2);
+
+  if (mystatx1.stx_atime.tv_sec<>mystatx2.stx_atime.tv_sec) or (mystatx1.stx_atime.tv_nsec<>mystatx2.stx_atime.tv_nsec) or
+    (mystatx1.stx_mtime.tv_sec<>mystatx2.stx_mtime.tv_sec) or (mystatx1.stx_mtime.tv_nsec<>mystatx2.stx_mtime.tv_nsec) then
+    halt(1);
+  writeln('ok');
+end.

tests/test/units/linux/tstatx.pp

@@ -4,7 +4,7 @@ uses
 
 var
   un : utsname;
-  mystatx : statx;
+  mystatx : tstatx;
   res : cint;
   f : text;
   st,major,minor : string;
@@ -41,7 +41,7 @@ begin
           end;
         break;
       end;
-  if (major_release<4) or (minor_release<11) then
+  if (major_release<4) or ((major_release=4) and (minor_release<11)) then
     begin
       writeln('This version of Linux: ',st,' does not have fstatx syscall');
       halt(0);
@@ -53,7 +53,7 @@ begin
   rewrite(f);
   write(f,'ccccc');
   close(f);
-  res:=fpstatx(AT_FDCWD,'test.txt',AT_SYMLINK_NOFOLLOW,STATX_ALL,mystatx);
+  res:=statx(AT_FDCWD,'test.txt',AT_SYMLINK_NOFOLLOW,STATX_ALL,mystatx);
   erase(f);
   if res<>0 then
     begin

tests/test/units/linux/tutimensat.pp

@@ -0,0 +1,83 @@
+{ %target=linux }
+uses
+  ctypes,baseunix,linux;
+
+var
+  un : utsname;
+  res : cint;
+  f1,f2 : text;
+  err : word;
+  mystatx1,mystatx2 : tstatx;
+  times : tkernel_timespecs;
+  st,major,minor : string;
+  i,p,e : longint;
+  major_release, minor_release : longint;
+begin
+  fpuname(un);
+  st:=un.release;
+  for i:=1 to UTSNAME_LENGTH do
+    if st[i]='.' then
+      begin
+        p:=i;
+        major:=system.copy(st,1,p-1);
+        system.val(major,major_release,err);
+        if err<>0 then
+          begin
+            writeln('Unable to parse first part of linux version ',st,'(',major,') correctly');
+            halt(2);
+          end;
+        break;
+      end;
+
+  for i:=p+1 to UTSNAME_LENGTH do
+    if st[i]='.' then
+      begin
+        e:=i;
+        minor:=system.copy(st,p+1,e-p-1);
+        system.val(minor,minor_release,err);
+        if err<>0 then
+          begin
+            writeln('Unable to second part of parse linux version ',st,'i(',minor,') correctly');
+            halt(2);
+          end;
+        break;
+      end;
+  if (major_release<4) or ((major_release=4) and (minor_release<11)) then
+    begin
+      writeln('This version of Linux: ',st,' does not have fstatx syscall');
+      halt(0);
+    end
+  else
+    writeln('This linux version ',st,' should support statx syscall');
+
+  assign(f1,'tutimensat1.txt');
+  rewrite(f1);
+  write(f1,'ccccc');
+  close(f1);
+  assign(f2,'tutimensat2.txt');
+  rewrite(f2);
+  write(f2,'ccccc');
+  close(f2);
+
+  res:=statx(AT_FDCWD,'tutimensat1.txt',AT_SYMLINK_NOFOLLOW,STATX_ALL,mystatx1);
+  if res<>0 then
+    halt(1);
+  times[0].tv_sec:=mystatx1.stx_atime.tv_sec;
+  times[0].tv_nsec:=mystatx1.stx_atime.tv_nsec;
+  times[1].tv_sec:=mystatx1.stx_mtime.tv_sec;
+  times[1].tv_nsec:=mystatx1.stx_mtime.tv_nsec;
+  res:=utimensat(AT_FDCWD,'tutimensat2.txt',times,0);
+  if res<>0 then
+    halt(1);
+  res:=statx(AT_FDCWD,'tutimensat2.txt',AT_SYMLINK_NOFOLLOW,STATX_ALL,mystatx2);
+  if res<>0 then
+    halt(1);
+
+  erase(f1);
+  erase(f2);
+
+  if (mystatx1.stx_atime.tv_sec<>mystatx2.stx_atime.tv_sec) or (mystatx1.stx_atime.tv_nsec<>mystatx2.stx_atime.tv_nsec) or
+    (mystatx1.stx_mtime.tv_sec<>mystatx2.stx_mtime.tv_sec) or (mystatx1.stx_mtime.tv_nsec<>mystatx2.stx_mtime.tv_nsec) then
+    halt(1);
+  writeln('ok');
+end.

tests/test/units/sysutils/tfile1.pp

@@ -32,6 +32,13 @@ BEGIN
   if FileSetDate('datetest.dat', DateTimeToFileDate(dateTime))<>0 then
     do_error(1002);
 
+  dateTime := IncMonth(Now, -1);
+  Assign(f,'datetest.dat');
+  Rewrite(f);
+  if FileSetDate(filerec(f).handle, DateTimeToFileDate(dateTime))<>0 then
+    do_error(1003);
+  Close(f);
+
   if FileExists('datetest.dat') then
     begin
       Assign(f,'datetest.dat');

tests/webtbs/tw38429.pp

@@ -0,0 +1,61 @@
+program tw38429;
+
+{$mode objfpc}{$h+}
+
+uses
+  SysUtils, Variants, uw38429;
+
+var
+  v, d: Variant;
+  I: Integer = 42;
+begin
+  Writeln('Test VarAsType');
+  d := I;
+  try
+    v := VarAsType(d, varMyVar);
+  except
+    on e: exception do begin
+      WriteLn('cast ', VarTypeAsText(VarType(d)), ' to ',VarTypeAsText(varMyVar),
+              ' raises ', e.ClassName, ' with message: ', e.Message);
+      Halt(1);
+    end;
+  end;
+  WriteLn('now v is ', VarTypeAsText(VarType(v)));
+  VarClear(d);
+  try
+    d := VarAsType(v, varInteger);
+  except
+    on e: exception do begin
+      WriteLn('cast ', VarTypeAsText(VarType(v)), ' to ',VarTypeAsText(varInteger),
+              ' raises ', e.ClassName, ' with message: ', e.Message);
+      Halt(2);
+    end;
+  end;
+  WriteLn('now d is ', VarTypeAsText(VarType(d)));
+
+  { also test VarCast from #20849 }
+  Writeln('Test VarCast');
+  d := I;
+  try
+    VarCast(v, d, varMyVar);
+  except
+    on e: exception do begin
+      WriteLn('cast ', VarTypeAsText(VarType(d)), ' to ',VarTypeAsText(varMyVar),
+              ' raises ', e.ClassName, ' with message: ', e.Message);
+      Halt(3);
+    end;
+  end;
+  WriteLn('now v is ', VarTypeAsText(VarType(v)));
+  VarClear(d);
+  try
+    VarCast(d, v, varInteger);
+  except
+    on e: exception do begin
+      WriteLn('cast ', VarTypeAsText(VarType(v)), ' to ',VarTypeAsText(varInteger),
+              ' raises ', e.ClassName, ' with message: ', e.Message);
+      Halt(4);
+    end;
+  end;
+  WriteLn('now d is ', VarTypeAsText(VarType(d)));
+end.
+

tests/webtbs/uw38429.pp

@@ -0,0 +1,88 @@
+unit uw38429;
+
+{$mode objfpc}{$H+}
+{$modeswitch advancedrecords}
+
+interface
+
+uses
+  SysUtils, Variants;
+
+type
+  TMyVar = packed record
+    VType: TVarType;
+    Dummy1: array[0..Pred(SizeOf(Pointer) - 2)] of Byte;
+    Dummy2,
+    Dummy3: Pointer;
+    procedure Init;
+  end;
+
+  { TMyVariant }
+
+  TMyVariant = class(TInvokeableVariantType)
+    procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override;
+    procedure Clear(var V: TVarData); override;
+    procedure Cast(var Dest: TVarData; const Source: TVarData); override;
+    procedure CastTo(var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); override;
+  end;
+
+  function MyVarCreate: Variant;
+
+  function varMyVar: TVarType;
+
+implementation
+
+var
+  MyVariant: TMyVariant;
+
+function MyVarCreate: Variant;
+begin
+  VarClear(Result);
+  TMyVar(Result).Init;
+end;
+
+function VarMyVar: TVarType;
+begin
+  Result := MyVariant.VarType;
+end;
+
+{ TMyVar }
+
+procedure TMyVar.Init;
+begin
+  VType := VarMyVar;
+end;
+
+{ TMyVariant }
+
+procedure TMyVariant.Copy(var Dest: TVarData; const Source: TVarData;
+  const Indirect: Boolean);
+begin
+  Dest := Source;
+end;
+
+procedure TMyVariant.Clear(var V: TVarData);
+begin
+  TMyVar(v).VType := varEmpty;
+end;
+
+procedure TMyVariant.Cast(var Dest: TVarData; const Source: TVarData);
+begin
+  WriteLn('TMyVariant.Cast');
+  VarClear(Variant(Dest));
+  TMyVar(Dest).Init;
+end;
+
+procedure TMyVariant.CastTo(var Dest: TVarData; const Source: TVarData; const aVarType: TVarType);
+begin
+  WriteLn('TMyVariant.CastTo');
+  VarClear(Variant(Dest));
+  TVarData(Dest).VType := aVarType;
+end;
+
+initialization
+  MyVariant := TMyVariant.Create;
+finalization
+  MyVariant.Free;
+end.
+