Browse Source

# revisions: 39668,39669,39671,39672,40652,41280,41281,42240,42244,42245,42286,42326,42456,42461,43048,43107,43108,43109,43110,43111,43112,43113

git-svn-id: branches/fixes_3_2@43394 -
marco 5 years ago
parent
commit
a4864e36f2

+ 3 - 0
.gitattributes

@@ -13836,6 +13836,7 @@ tests/test/trtti17.pp svneol=native#text/pascal
 tests/test/trtti18a.pp svneol=native#text/pascal
 tests/test/trtti18a.pp svneol=native#text/pascal
 tests/test/trtti18b.pp svneol=native#text/pascal
 tests/test/trtti18b.pp svneol=native#text/pascal
 tests/test/trtti2.pp svneol=native#text/plain
 tests/test/trtti2.pp svneol=native#text/plain
+tests/test/trtti20.pp svneol=native#text/pascal
 tests/test/trtti3.pp svneol=native#text/plain
 tests/test/trtti3.pp svneol=native#text/plain
 tests/test/trtti4.pp svneol=native#text/plain
 tests/test/trtti4.pp svneol=native#text/plain
 tests/test/trtti5.pp svneol=native#text/plain
 tests/test/trtti5.pp svneol=native#text/plain
@@ -16406,6 +16407,8 @@ tests/webtbs/tw3492.pp svneol=native#text/plain
 tests/webtbs/tw3494.pp svneol=native#text/plain
 tests/webtbs/tw3494.pp svneol=native#text/plain
 tests/webtbs/tw34971.pp svneol=native#text/plain
 tests/webtbs/tw34971.pp svneol=native#text/plain
 tests/webtbs/tw3499.pp svneol=native#text/plain
 tests/webtbs/tw3499.pp svneol=native#text/plain
+tests/webtbs/tw35027.pp svneol=native#text/pascal
+tests/webtbs/tw35028.pp svneol=native#text/pascal
 tests/webtbs/tw3504.pp svneol=native#text/plain
 tests/webtbs/tw3504.pp svneol=native#text/plain
 tests/webtbs/tw3506.pp svneol=native#text/plain
 tests/webtbs/tw3506.pp svneol=native#text/plain
 tests/webtbs/tw35139.pp svneol=native#text/plain
 tests/webtbs/tw35139.pp svneol=native#text/plain

+ 9 - 3
rtl/amicommon/sysutils.pp

@@ -396,7 +396,13 @@ begin
 end;
 end;
 
 
 
 
-function FileExists (const FileName : RawByteString) : Boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+function FileExists (const FileName : RawByteString; FollowLink : Boolean) : Boolean;
 var
 var
   tmpLock: BPTR;
   tmpLock: BPTR;
   tmpFIB : PFileInfoBlock;
   tmpFIB : PFileInfoBlock;
@@ -702,7 +708,7 @@ begin
   DiskFree := DiskFree(DeviceList[Drive]);
   DiskFree := DiskFree(DeviceList[Drive]);
 end;
 end;
 
 
-function DirectoryExists(const Directory: RawByteString): Boolean;
+function DirectoryExists(const Directory: RawByteString; FollowLink : Boolean): Boolean;
 var
 var
   tmpLock: BPTR;
   tmpLock: BPTR;
   FIB    : PFileInfoBlock;
   FIB    : PFileInfoBlock;
@@ -948,6 +954,6 @@ Initialization
 
 
   RefreshDeviceList;
   RefreshDeviceList;
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/atari/sysutils.pp

@@ -216,7 +216,13 @@ begin
 end;
 end;
 
 
 
 
-function FileExists (const FileName : RawByteString) : Boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+function FileExists (const FileName : RawByteString; FollowLink : Boolean) : Boolean;
 var
 var
   Attr: longint;
   Attr: longint;
 begin
 begin
@@ -372,7 +378,7 @@ begin
   DiskFree:=di.b_free * di.b_secsiz * di.b_clsiz;
   DiskFree:=di.b_free * di.b_secsiz * di.b_clsiz;
 end;
 end;
 
 
-function DirectoryExists(const Directory: RawByteString): Boolean;
+function DirectoryExists(const Directory: RawByteString; FollowLink : Boolean): Boolean;
 var
 var
   Attr: longint;
   Attr: longint;
 begin
 begin
@@ -526,6 +532,6 @@ Initialization
   OnBeep:=Nil;          { No SysBeep() on Atari for now. }
   OnBeep:=Nil;          { No SysBeep() on Atari for now. }
 
 
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/embedded/sysutils.pp

@@ -135,7 +135,13 @@ begin
 end;
 end;
 
 
 
 
-Function FileExists (Const FileName : RawByteString) : Boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+Function FileExists (Const FileName : RawByteString; FollowLink : Boolean) : Boolean;
 Begin
 Begin
   result := false;
   result := false;
 end;
 end;
@@ -191,7 +197,7 @@ Begin
 End;
 End;
 
 
 
 
-function DirectoryExists(const Directory: RawByteString): Boolean;
+function DirectoryExists(const Directory: RawByteString; FollowLink : Boolean): Boolean;
 begin
 begin
   result := false;
   result := false;
 end;
 end;
@@ -285,6 +291,6 @@ end;
 Initialization
 Initialization
   InitExceptions;
   InitExceptions;
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/emx/sysutils.pp

@@ -661,7 +661,13 @@ begin
 end;
 end;
 
 
 
 
-function FileExists (const FileName: RawByteString): boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+function FileExists (const FileName: RawByteString; FollowLink : Boolean): boolean;
 var
 var
   L: longint;
   L: longint;
 begin
 begin
@@ -1050,7 +1056,7 @@ begin
 end;
 end;
 
 
 
 
-function DirectoryExists (const Directory: RawByteString): boolean;
+function DirectoryExists (const Directory: RawByteString; FollowLink : Boolean): boolean;
 var
 var
   L: longint;
   L: longint;
 begin
 begin
@@ -1334,6 +1340,6 @@ Initialization
   InitExceptions;       { Initialize exceptions. OS independent }
   InitExceptions;       { Initialize exceptions. OS independent }
   InitInternational;    { Initialize internationalization settings }
   InitInternational;    { Initialize internationalization settings }
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/gba/sysutils.pp

@@ -146,7 +146,13 @@ begin
 end;
 end;
 
 
 
 
-Function FileExists (Const FileName : RawByteString) : Boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+Function FileExists (Const FileName : RawByteString; FollowLink : Boolean) : Boolean;
 Begin
 Begin
   result := false;
   result := false;
 end;
 end;
@@ -204,7 +210,7 @@ Begin
 End;
 End;
 
 
 
 
-function DirectoryExists(const Directory: RawByteString): Boolean;
+function DirectoryExists(const Directory: RawByteString; FollowLink : Boolean): Boolean;
 begin
 begin
   result := false;
   result := false;
 end;
 end;
@@ -319,6 +325,6 @@ end;
 Initialization
 Initialization
   InitExceptions;
   InitExceptions;
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/go32v2/sysutils.pp

@@ -298,7 +298,13 @@ begin
 end;
 end;
 
 
 
 
-function FileExists (const FileName: RawByteString): boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+function FileExists (const FileName: RawByteString; FollowLink : Boolean): boolean;
 var
 var
   L: longint;
   L: longint;
 begin
 begin
@@ -314,7 +320,7 @@ begin
 end;
 end;
 
 
 
 
-Function DirectoryExists (Const Directory : RawByteString) : Boolean;
+Function DirectoryExists (Const Directory : RawByteString; FollowLink : Boolean) : Boolean;
 Var
 Var
   Dir : RawByteString;
   Dir : RawByteString;
   drive : byte;
   drive : byte;
@@ -914,6 +920,6 @@ Initialization
   InitInternational;    { Initialize internationalization settings }
   InitInternational;    { Initialize internationalization settings }
   OnBeep:=@SysBeep;
   OnBeep:=@SysBeep;
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/macos/sysutils.pp

@@ -210,7 +210,13 @@ begin
 end;
 end;
 
 
 
 
-Function FileExists (Const FileName : RawByteString) : Boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+Function FileExists (Const FileName : RawByteString; FollowLink : Boolean) : Boolean;
 
 
   (*
   (*
 Var Info : Stat;
 Var Info : Stat;
@@ -223,7 +229,7 @@ begin
 end;
 end;
 
 
 
 
-Function DirectoryExists (Const Directory : RawByteString) : Boolean;
+Function DirectoryExists (Const Directory : RawByteString; FollowLink : Boolean) : Boolean;
 
 
   (*
   (*
 Var Info : Stat;
 Var Info : Stat;
@@ -843,6 +849,6 @@ Initialization
   InitExceptions;       { Initialize exceptions. OS independent }
   InitExceptions;       { Initialize exceptions. OS independent }
   InitInternational;    { Initialize internationalization settings }
   InitInternational;    { Initialize internationalization settings }
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/msdos/sysutils.pp

@@ -303,7 +303,13 @@ begin
 end;
 end;
 
 
 
 
-function FileExists (const FileName: RawByteString): boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+function FileExists (const FileName: RawByteString; FollowLink : Boolean): boolean;
 var
 var
   L: longint;
   L: longint;
 begin
 begin
@@ -318,7 +324,7 @@ begin
 end;
 end;
 
 
 
 
-Function DirectoryExists (Const Directory : RawByteString) : Boolean;
+Function DirectoryExists (Const Directory : RawByteString; FollowLink : Boolean) : Boolean;
 Var
 Var
   Dir : RawByteString;
   Dir : RawByteString;
   drive : byte;
   drive : byte;
@@ -923,6 +929,6 @@ Initialization
   InitInternational;    { Initialize internationalization settings }
   InitInternational;    { Initialize internationalization settings }
   OnBeep:=@SysBeep;
   OnBeep:=@SysBeep;
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/nativent/sysutils.pp

@@ -320,7 +320,13 @@ begin
 end;
 end;
 
 
 
 
-function FileExists(const FileName: UnicodeString): Boolean;
+function FileGetSymLinkTarget(const FileName: UnicodeString; out SymLinkRec: TUnicodeSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+function FileExists(const FileName: UnicodeString; FollowLink : Boolean): Boolean;
 var
 var
   ntstr: UNICODE_STRING;
   ntstr: UNICODE_STRING;
   objattr: OBJECT_ATTRIBUTES;
   objattr: OBJECT_ATTRIBUTES;
@@ -341,7 +347,7 @@ begin
 end;
 end;
 
 
 
 
-function DirectoryExists(const Directory : UnicodeString) : Boolean;
+function DirectoryExists(const Directory : UnicodeString; FollowLink : Boolean) : Boolean;
 var
 var
   ntstr: UNICODE_STRING;
   ntstr: UNICODE_STRING;
   objattr: OBJECT_ATTRIBUTES;
   objattr: OBJECT_ATTRIBUTES;
@@ -1257,6 +1263,6 @@ initialization
   InitInternational;    { Initialize internationalization settings }
   InitInternational;    { Initialize internationalization settings }
   OnBeep := @SysBeep;
   OnBeep := @SysBeep;
 finalization
 finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/nds/sysutils.pp

@@ -179,7 +179,13 @@ begin
 end;
 end;
 
 
 
 
-Function FileExists (Const FileName : RawByteString) : Boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+Function FileExists (Const FileName : RawByteString; FollowLink : Boolean) : Boolean;
 var
 var
   SystemFileName: RawByteString;
   SystemFileName: RawByteString;
 begin
 begin
@@ -248,7 +254,7 @@ Begin
 End;
 End;
 
 
 
 
-function DirectoryExists(const Directory: RawByteString): Boolean;
+function DirectoryExists(const Directory: RawByteString; FollowLink : Boolean): Boolean;
 begin
 begin
   result := false;
   result := false;
 end;
 end;
@@ -358,6 +364,6 @@ end;
 Initialization
 Initialization
   InitExceptions;
   InitExceptions;
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 10 - 4
rtl/netware/sysutils.pp

@@ -230,7 +230,13 @@ begin
 end;
 end;
 
 
 
 
-Function FileExists (Const FileName : RawByteString) : Boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+Function FileExists (Const FileName : RawByteString; FollowLink : Boolean) : Boolean;
 VAR Info : NWStatBufT;
 VAR Info : NWStatBufT;
     SystemFileName: RawByteString;
     SystemFileName: RawByteString;
 begin
 begin
@@ -238,7 +244,7 @@ begin
   FileExists:=(_stat(pchar(SystemFileName),Info) = 0);
   FileExists:=(_stat(pchar(SystemFileName),Info) = 0);
 end;
 end;
 
 
-Function DirectoryExists (Const Directory : RawByteString) : Boolean;
+Function DirectoryExists (Const Directory : RawByteString; FollowLink : Boolean) : Boolean;
 Var
 Var
   Dir : RawByteString;
   Dir : RawByteString;
   drive : byte;
   drive : byte;
@@ -497,7 +503,7 @@ Begin
 End;
 End;
 
 
 
 
-function DirectoryExists (const Directory: string): boolean;
+function DirectoryExists (const Directory: string; FollowLink : Boolean): boolean;
 var
 var
   Info : NWStatBufT;
   Info : NWStatBufT;
   SystemFileName: RawByteString;
   SystemFileName: RawByteString;
@@ -655,6 +661,6 @@ Initialization
   InitInternational;    { Initialize internationalization settings }
   InitInternational;    { Initialize internationalization settings }
   OnBeep:=@SysBeep;
   OnBeep:=@SysBeep;
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/netwlibc/sysutils.pp

@@ -218,7 +218,13 @@ begin
 end;
 end;
 
 
 
 
-Function FileExists (Const FileName : RawByteString) : Boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+Function FileExists (Const FileName : RawByteString; FollowLink : Boolean) : Boolean;
 VAR Info : TStat;
 VAR Info : TStat;
     SystemFileName: RawByteString;
     SystemFileName: RawByteString;
 begin
 begin
@@ -503,7 +509,7 @@ Begin
 End;
 End;
 
 
 
 
-function DirectoryExists (const Directory: RawByteString): boolean;
+function DirectoryExists (const Directory: RawByteString; FollowLink : Boolean): boolean;
 var
 var
   Info : TStat;
   Info : TStat;
   SystemFileName: RawByteString;
   SystemFileName: RawByteString;
@@ -722,6 +728,6 @@ Initialization
   InitExceptions;       { Initialize exceptions. OS independent }
   InitExceptions;       { Initialize exceptions. OS independent }
   InitInternational;    { Initialize internationalization settings }
   InitInternational;    { Initialize internationalization settings }
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 18 - 13
rtl/objpas/classes/classes.inc

@@ -308,9 +308,12 @@ begin
   if (GetCurrentThreadID = MainThreadID) and (not aQueueIfMain or not IsMultiThread) then
   if (GetCurrentThreadID = MainThreadID) and (not aQueueIfMain or not IsMultiThread) then
 {$endif}
 {$endif}
   begin
   begin
-    ExecuteThreadQueueEntry(aEntry);
-    if not Assigned(aEntry^.SyncEvent) then
-      Dispose(aEntry);
+    try
+      ExecuteThreadQueueEntry(aEntry);
+    finally
+      if not Assigned(aEntry^.SyncEvent) then
+        Dispose(aEntry);
+    end;
 {$ifdef FPC_HAS_FEATURE_THREADING}
 {$ifdef FPC_HAS_FEATURE_THREADING}
   end else begin
   end else begin
     { store thread and whether we're dealing with a synchronized event; the
     { store thread and whether we're dealing with a synchronized event; the
@@ -415,17 +418,19 @@ class procedure TThread.Synchronize(AThread: TThread; AMethod: TThreadMethod);
 
 
     syncentry^.Exception := Nil;
     syncentry^.Exception := Nil;
     syncentry^.Method := AMethod;
     syncentry^.Method := AMethod;
-    ThreadQueueAppend(syncentry, False);
-
-    syncentry^.Method := Nil;
-    syncentry^.Next := Nil;
+    try
+      ThreadQueueAppend(syncentry, False);
+    finally
+      syncentry^.Method := Nil;
+      syncentry^.Next := Nil;
 
 
-    if not Assigned(thread) then begin
-      { clean up again }
+      if not Assigned(thread) then begin
+        { clean up again }
 {$ifdef FPC_HAS_FEATURE_THREADING}
 {$ifdef FPC_HAS_FEATURE_THREADING}
-      RtlEventDestroy(syncentry^.SyncEvent);
+        RtlEventDestroy(syncentry^.SyncEvent);
 {$endif}
 {$endif}
-      Dispose(syncentry);
+        Dispose(syncentry);
+      end;
     end;
     end;
   end;
   end;
 
 
@@ -462,7 +467,7 @@ function CheckSynchronize(timeout : longint=0) : boolean;
 
 
 { assumes being called from GUI thread }
 { assumes being called from GUI thread }
 var
 var
-  ExceptObj: Exception;
+  ExceptObj: TObject;
   tmpentry: TThread.PThreadQueueEntry;
   tmpentry: TThread.PThreadQueueEntry;
 
 
 begin
 begin
@@ -486,7 +491,7 @@ begin
     try
     try
       ExecuteThreadQueueEntry(tmpentry);
       ExecuteThreadQueueEntry(tmpentry);
     except
     except
-      exceptobj := Exception(AcquireExceptionObject);
+      exceptobj := TObject(AcquireExceptionObject);
     end;
     end;
     { step 3: error handling and cleanup }
     { step 3: error handling and cleanup }
     if Assigned(tmpentry^.SyncEvent) then
     if Assigned(tmpentry^.SyncEvent) then

+ 1 - 1
rtl/objpas/classes/classesh.inc

@@ -1650,7 +1650,7 @@ type
       //ThreadProc: TThreadProcedure;
       //ThreadProc: TThreadProcedure;
       Thread: TThread;
       Thread: TThread;
       ThreadID: TThreadID;
       ThreadID: TThreadID;
-      Exception: Exception;
+      Exception: TObject;
       SyncEvent: PRtlEvent;
       SyncEvent: PRtlEvent;
       Next: PThreadQueueEntry;
       Next: PThreadQueueEntry;
     end;
     end;

+ 104 - 12
rtl/objpas/sysutils/filutil.inc

@@ -46,15 +46,15 @@ begin
 end;
 end;
 
 
 
 
-Function FileExists (Const FileName : UnicodeString) : Boolean;
+Function FileExists (Const FileName : UnicodeString; FollowLink : Boolean) : Boolean;
 begin
 begin
-  Result:=FileExists(ToSingleByteFileSystemEncodedFileName(FileName));
+  Result:=FileExists(ToSingleByteFileSystemEncodedFileName(FileName), FollowLink);
 end;
 end;
 
 
 
 
-Function DirectoryExists (Const Directory : UnicodeString) : Boolean;
+Function DirectoryExists (Const Directory : UnicodeString; FollowLink : Boolean) : Boolean;
 begin
 begin
-  Result:=DirectoryExists(ToSingleByteFileSystemEncodedFileName(Directory));
+  Result:=DirectoryExists(ToSingleByteFileSystemEncodedFileName(Directory), FollowLink);
 end;
 end;
 
 
 
 
@@ -125,6 +125,26 @@ begin
 end;
 end;
 
 
 
 
+function FileGetSymLinkTarget(const FileName: UnicodeString; out SymLinkRec: TUnicodeSymLinkRec): Boolean;
+var
+  sr: TRawbyteSymLinkRec;
+begin
+  Result := FileGetSymLinkTarget(ToSingleByteFileSystemEncodedFileName(FileName), sr);
+  if Result then
+    begin
+      SymLinkRec.TargetName := UnicodeString(sr.TargetName);
+      SymLinkRec.Size := sr.Size;
+      SymLinkRec.Attr := sr.Attr;
+{$ifdef SYMLINKREC_USEFINDDATA}
+      SymLinkRec.FindData := sr.FindData;
+{$endif}
+{$ifdef unix}
+      SymLinkRec.Mode := sr.Mode;
+{$endif}
+    end;
+end;
+
+
 Function FileSearch (Const Name, DirList : UnicodeString; Options : TFileSearchoptions = [sfoImplicitCurrentDir]) : UnicodeString;
 Function FileSearch (Const Name, DirList : UnicodeString; Options : TFileSearchoptions = [sfoImplicitCurrentDir]) : UnicodeString;
 begin
 begin
   Result:=UnicodeString(FileSearch(ToSingleByteFileSystemEncodedFileName(Name),
   Result:=UnicodeString(FileSearch(ToSingleByteFileSystemEncodedFileName(Name),
@@ -243,15 +263,15 @@ begin
 end;
 end;
 
 
 
 
-Function FileExists (Const FileName : RawByteString) : Boolean;
+Function FileExists (Const FileName : RawByteString; FollowLink : Boolean) : Boolean;
 begin
 begin
-  Result:=FileExists(UnicodeString(FileName));
+  Result:=FileExists(UnicodeString(FileName), FollowLink);
 end;
 end;
 
 
 
 
-Function DirectoryExists (Const Directory : RawByteString) : Boolean;
+Function DirectoryExists (Const Directory : RawByteString; FollowLink : Boolean) : Boolean;
 begin
 begin
-  Result:=DirectoryExists(UnicodeString(Directory));
+  Result:=DirectoryExists(UnicodeString(Directory), FollowLink);
 end;
 end;
 
 
 
 
@@ -320,6 +340,26 @@ begin
 end;
 end;
 
 
 
 
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+var
+  sr: TUnicodeSymLinkRec;
+begin
+  Result := FileGetSymLinkTarget(UnicodeString(FileName), sr);
+  if Result then
+    begin
+      SymLinkRec.TargetName := ToSingleByteFileSystemEncodedFileName(sr.TargetName);
+      SymLinkRec.Size := sr.Size;
+      SymLinkRec.Attr := sr.Attr;
+{$ifdef SYMLINKREC_USEFINDDATA}
+      SymLinkRec.FindData := sr.FindData;
+{$endif}
+{$ifdef unix}
+      SymLinkRec.Mode := sr.Mode;
+{$endif}
+    end;
+end;
+
+
 Function FileSearch (Const Name, DirList : UnicodeString; Options : TFileSearchoptions = [sfoImplicitCurrentDir]) : UnicodeString;
 Function FileSearch (Const Name, DirList : UnicodeString; Options : TFileSearchoptions = [sfoImplicitCurrentDir]) : UnicodeString;
 Var
 Var
   I : longint;
   I : longint;
@@ -403,6 +443,26 @@ end;
 {$endif}
 {$endif}
 
 
 
 
+function FileGetSymLinkTarget(const FileName: UnicodeString; out TargetName: UnicodeString): Boolean;
+var
+  sr: TUnicodeSymLinkRec;
+begin
+  Result := FileGetSymLinkTarget(FileName, sr);
+  if Result then
+    TargetName := sr.TargetName;
+end;
+
+
+function FileGetSymLinkTarget(const FileName: RawByteString; out TargetName: RawByteString): Boolean;
+var
+  sr: TRawbyteSymLinkRec;
+begin
+  Result := FileGetSymLinkTarget(FileName, sr);
+  if Result then
+    TargetName := sr.TargetName;
+end;
+
+
 Function GetFileHandle(var f : File):THandle;
 Function GetFileHandle(var f : File):THandle;
 begin
 begin
   Result:=filerec(f).handle;
   Result:=filerec(f).handle;
@@ -437,7 +497,7 @@ type
   {$ifdef unix}
   {$ifdef unix}
     Mode : TMode;
     Mode : TMode;
   {$endif unix}
   {$endif unix}
-  {$ifdef USEFINDDATA}
+  {$ifdef SEARCHREC_USEFINDDATA}
     FindData : TFindData;
     FindData : TFindData;
   {$endif}
   {$endif}
   end;
   end;
@@ -453,7 +513,7 @@ Function InternalFindFirst (Const Path : UnicodeString; Attr : Longint; out Rslt
 Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : UnicodeString) : Longint; forward;
 Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : UnicodeString) : Longint; forward;
 {$endif SYSUTILS_HAS_UNICODESTR_FILEUTIL_IMPL}
 {$endif SYSUTILS_HAS_UNICODESTR_FILEUTIL_IMPL}
 
 
-procedure InternalFindClose(var Handle: {$ifdef FINDHANDLE_IS_POINTER}Pointer{$else}THandle{$endif}{$ifdef USEFINDDATA};var FindData: TFindData{$endif}); forward;
+procedure InternalFindClose(var Handle: {$ifdef FINDHANDLE_IS_POINTER}Pointer{$else}THandle{$endif}{$ifdef SEARCHREC_USEFINDDATA};var FindData: TFindData{$endif}); forward;
 
 
 
 
 {$ifndef SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
 {$ifndef SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
@@ -533,13 +593,13 @@ end;
 
 
 Procedure FindClose(Var f: TRawByteSearchRec);
 Procedure FindClose(Var f: TRawByteSearchRec);
 begin
 begin
-  InternalFindClose(f.FindHandle{$ifdef USEFINDDATA},f.FindData{$endif});
+  InternalFindClose(f.FindHandle{$ifdef SEARCHREC_USEFINDDATA},f.FindData{$endif});
 end;
 end;
 
 
 
 
 Procedure FindClose(Var f: TUnicodeSearchRec);
 Procedure FindClose(Var f: TUnicodeSearchRec);
 begin
 begin
-  InternalFindClose(f.FindHandle{$ifdef USEFINDDATA},f.FindData{$endif});
+  InternalFindClose(f.FindHandle{$ifdef SEARCHREC_USEFINDDATA},f.FindData{$endif});
 end;
 end;
 
 
 { TUnicodeSearchRec }
 { TUnicodeSearchRec }
@@ -556,6 +616,38 @@ begin
   Result := FileDateToDateTime(Time);
   Result := FileDateToDateTime(Time);
 end;
 end;
 
 
+{ TUnicodeSymLinkRec }
+
+function TUnicodeSymLinkRec.GetTimeStamp: TDateTime;
+{$if defined(win32) or defined(win64) or defined(wince)}
+var
+  st: TSystemTime;
+{$endif}
+begin
+{$if defined(win32) or defined(win64) or defined(wince)}
+  FileTimeToSystemTime(FindData.ftLastWriteTime, st);
+  Result := SystemTimeToDateTime(st);
+{$else}
+  Result := 0;
+{$endif}
+end;
+
+{ TRawbyteSymLinkRec }
+
+function TRawbyteSymLinkRec.GetTimeStamp: TDateTime;
+{$if defined(win32) or defined(win64) or defined(wince)}
+var
+  st: TSystemTime;
+{$endif}
+begin
+{$if defined(win32) or defined(win64) or defined(wince)}
+  FileTimeToSystemTime(FindData.ftLastWriteTime, st);
+  Result := SystemTimeToDateTime(st);
+{$else}
+  Result := 0;
+{$endif}
+end;
+
 
 
 {$ifndef SYSUTILS_HAS_FILEFLUSH_IMPL}
 {$ifndef SYSUTILS_HAS_FILEFLUSH_IMPL}
 function FileFlush(Handle: THandle): Boolean;
 function FileFlush(Handle: THandle): Boolean;

+ 55 - 11
rtl/objpas/sysutils/filutilh.inc

@@ -23,24 +23,25 @@ Type
 
 
   // Some operating systems need extra find data.
   // Some operating systems need extra find data.
 {$if defined(Win32) or defined(WinCE) or defined(Win64)}
 {$if defined(Win32) or defined(WinCE) or defined(Win64)}
-    {$define USEFINDDATA}
+    {$define SEARCHREC_USEFINDDATA}
+    {$define SYMLINKREC_USEFINDDATA}
     TFindData = TWin32FindDataW;
     TFindData = TWin32FindDataW;
 {$endif}
 {$endif}
 {$ifdef netware_clib}
 {$ifdef netware_clib}
     TFindData = TNetwareFindData;
     TFindData = TNetwareFindData;
-    {$define USEFINDDATA}
+    {$define SEARCHREC_USEFINDDATA}
 {$endif}
 {$endif}
 {$ifdef netware_libc}
 {$ifdef netware_libc}
     TFindData = TNetwareLibcFindData;
     TFindData = TNetwareLibcFindData;
-    {$define USEFINDDATA}
+    {$define SEARCHREC_USEFINDDATA}
 {$endif}
 {$endif}
 {$ifdef MacOS}
 {$ifdef MacOS}
     TFindData = TMacOSFindData;
     TFindData = TMacOSFindData;
-    {$define USEFINDDATA}
+    {$define SEARCHREC_USEFINDDATA}
 {$endif}
 {$endif}
 {$ifdef nativent}
 {$ifdef nativent}
     TFindData = TNativeNTFindData;
     TFindData = TNativeNTFindData;
-    {$define USEFINDDATA}
+    {$define SEARCHREC_USEFINDDATA}
 {$endif}
 {$endif}
 
 
   // The actual unicode search record
   // The actual unicode search record
@@ -54,7 +55,7 @@ Type
 {$ifdef unix}
 {$ifdef unix}
     Mode : TMode;
     Mode : TMode;
 {$endif unix}
 {$endif unix}
-{$ifdef USEFINDDATA}
+{$ifdef SEARCHREC_USEFINDDATA}
     FindData : TFindData;
     FindData : TFindData;
 {$endif}
 {$endif}
   private
   private
@@ -73,7 +74,7 @@ Type
 {$ifdef unix}
 {$ifdef unix}
     Mode : TMode;
     Mode : TMode;
 {$endif unix}
 {$endif unix}
-{$IFDEF USEFINDDATA}
+{$IFDEF SEARCHREC_USEFINDDATA}
     FindData : TFindData;
     FindData : TFindData;
 {$ENDIF}
 {$ENDIF}
   private
   private
@@ -88,6 +89,45 @@ Type
   TSearchRec = TRawbyteSearchRec;
   TSearchRec = TRawbyteSearchRec;
 {$ENDIF}
 {$ENDIF}
 
 
+  TUnicodeSymLinkRec = Record
+    TargetName : UnicodeString;
+    Attr : Longint;
+    Size : Int64;
+{$ifdef unix}
+    Mode : TMode;
+{$endif unix}
+{$ifdef SYMLINKREC_USEFINDDATA}
+    FindData : TFindData;
+{$endif}
+  private
+    function GetTimeStamp: TDateTime;
+  public
+    property TimeStamp: TDateTime read GetTimeStamp;
+  end;
+
+  TRawbyteSymLinkRec = Record
+    TargetName : RawByteString;
+    Size : Int64;
+    Attr : Longint;
+{$ifdef unix}
+    Mode : TMode;
+{$endif unix}
+{$IFDEF SYMLINKREC_USEFINDDATA}
+    FindData : TFindData;
+{$ENDIF}
+  private
+    function GetTimeStamp: TDateTime;
+  public
+    property TimeStamp: TDateTime read GetTimeStamp;
+  end;
+
+{$IFDEF FPC_UNICODE_RTL}
+  TSymLinkRec = TUnicodeSymLinkRec;
+{$ELSE}
+  TSymLinkRec = TRawbyteSymLinkRec;
+{$ENDIF}
+
+
 Const
 Const
   { File attributes }
   { File attributes }
   faReadOnly   = $00000001;
   faReadOnly   = $00000001;
@@ -135,8 +175,8 @@ Function FileCreate (Const FileName : UnicodeString; ShareMode : Integer; Rights
 {$IFNDEF FPUNONE}
 {$IFNDEF FPUNONE}
 Function FileAge (Const FileName : UnicodeString): Longint;
 Function FileAge (Const FileName : UnicodeString): Longint;
 {$ENDIF}
 {$ENDIF}
-Function FileExists (Const FileName : UnicodeString) : Boolean;
-Function DirectoryExists (Const Directory : UnicodeString) : Boolean;
+Function FileExists (Const FileName : UnicodeString; FollowLink : Boolean = True) : Boolean;
+Function DirectoryExists (Const Directory : UnicodeString; FollowLink : Boolean = True) : Boolean;
 Function FileSetDate (Const FileName : UnicodeString;Age : Longint) : Longint;
 Function FileSetDate (Const FileName : UnicodeString;Age : Longint) : Longint;
 Function FileGetAttr (Const FileName : UnicodeString) : Longint;
 Function FileGetAttr (Const FileName : UnicodeString) : Longint;
 Function FileSetAttr (Const Filename : UnicodeString; Attr: longint) : Longint;
 Function FileSetAttr (Const Filename : UnicodeString; Attr: longint) : Longint;
@@ -150,13 +190,15 @@ Function FileSearch (Const Name, DirList : UnicodeString; ImplicitCurrentDir : B
 Function ExeSearch  (Const Name : UnicodeString; Const DirList : UnicodeString = '') : UnicodeString;
 Function ExeSearch  (Const Name : UnicodeString; Const DirList : UnicodeString = '') : UnicodeString;
 Function FileIsReadOnly(const FileName : UnicodeString): Boolean;
 Function FileIsReadOnly(const FileName : UnicodeString): Boolean;
 function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
 function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
+function FileGetSymLinkTarget(const FileName: UnicodeString; out SymLinkRec: TUnicodeSymLinkRec): Boolean;
+function FileGetSymLinkTarget(const FileName: UnicodeString; out TargetName: UnicodeString): Boolean; inline;
 
 
 Function FileOpen (Const FileName : RawByteString; Mode : Integer) : THandle;
 Function FileOpen (Const FileName : RawByteString; Mode : Integer) : THandle;
 Function FileCreate (Const FileName : RawByteString) : THandle;
 Function FileCreate (Const FileName : RawByteString) : THandle;
 Function FileCreate (Const FileName : RawByteString; Rights : Integer) : THandle;
 Function FileCreate (Const FileName : RawByteString; Rights : Integer) : THandle;
 Function FileCreate (Const FileName : RawByteString; ShareMode : Integer; Rights : Integer) : THandle;
 Function FileCreate (Const FileName : RawByteString; ShareMode : Integer; Rights : Integer) : THandle;
-Function FileExists (Const FileName : RawByteString) : Boolean;
-Function DirectoryExists (Const Directory : RawByteString) : Boolean;
+Function FileExists (Const FileName : RawByteString; FollowLink : Boolean = True) : Boolean;
+Function DirectoryExists (Const Directory : RawByteString; FollowLink: Boolean = True) : Boolean;
 Function FileSetDate (Const FileName : RawByteString;Age : Longint) : Longint;
 Function FileSetDate (Const FileName : RawByteString;Age : Longint) : Longint;
 Function FileGetAttr (Const FileName : RawByteString) : Longint;
 Function FileGetAttr (Const FileName : RawByteString) : Longint;
 Function FileSetAttr (Const Filename : RawByteString; Attr: longint) : Longint;
 Function FileSetAttr (Const Filename : RawByteString; Attr: longint) : Longint;
@@ -171,6 +213,8 @@ function FileAge(const FileName: RawByteString; out FileDateTime: TDateTime; Fol
 {$ifndef FPUNONE}
 {$ifndef FPUNONE}
 Function FileAge (Const FileName : RawByteString): Longint;
 Function FileAge (Const FileName : RawByteString): Longint;
 {$endif}
 {$endif}
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out TargetName: RawByteString): Boolean; inline;
 
 
 Function FileRead (Handle : THandle; out Buffer; Count : longint) : Longint;
 Function FileRead (Handle : THandle; out Buffer; Count : longint) : Longint;
 Function FileWrite (Handle : THandle; const Buffer; Count : Longint) : Longint;
 Function FileWrite (Handle : THandle; const Buffer; Count : Longint) : Longint;

+ 108 - 33
rtl/objpas/typinfo.pp

@@ -881,11 +881,15 @@ procedure AddEnumElementAliases(aTypeInfo: PTypeInfo; const aNames: array of str
 procedure RemoveEnumElementAliases(aTypeInfo: PTypeInfo);
 procedure RemoveEnumElementAliases(aTypeInfo: PTypeInfo);
 function GetEnumeratedAliasValue(aTypeInfo: PTypeInfo; const aName: string): Integer;
 function GetEnumeratedAliasValue(aTypeInfo: PTypeInfo; const aName: string): Integer;
 
 
-function SetToString(TypeInfo: PTypeInfo; Value: Integer; Brackets: Boolean) : String;
-function SetToString(PropInfo: PPropInfo; Value: Integer; Brackets: Boolean) : String;
-function SetToString(PropInfo: PPropInfo; Value: Integer) : String;
-function StringToSet(PropInfo: PPropInfo; const Value: string): Integer;
-function StringToSet(TypeInfo: PTypeInfo; const Value: string): Integer;
+function SetToString(TypeInfo: PTypeInfo; Value: LongInt; Brackets: Boolean) : String;
+function SetToString(PropInfo: PPropInfo; Value: LongInt; Brackets: Boolean) : String;
+function SetToString(PropInfo: PPropInfo; Value: LongInt) : String;
+function SetToString(TypeInfo: PTypeInfo; Value: Pointer; Brackets: Boolean = False) : String;
+function SetToString(PropInfo: PPropInfo; Value: Pointer; Brackets: Boolean = False) : String;
+function StringToSet(PropInfo: PPropInfo; const Value: string): LongInt;
+function StringToSet(TypeInfo: PTypeInfo; const Value: string): LongInt;
+procedure StringToSet(PropInfo: PPropInfo; const Value: String; Result: Pointer);
+procedure StringToSet(TypeInfo: PTypeInfo; const Value: String; Result: Pointer);
 
 
 const
 const
     BooleanIdents: array[Boolean] of String = ('False', 'True');
     BooleanIdents: array[Boolean] of String = ('False', 'True');
@@ -1041,53 +1045,93 @@ begin
 end;
 end;
 
 
 
 
-Function SetToString(PropInfo: PPropInfo; Value: Integer; Brackets: Boolean) : String;
+Function SetToString(PropInfo: PPropInfo; Value: LongInt; Brackets: Boolean) : String;
 
 
 begin
 begin
-  Result:=SetToString(PropInfo^.PropType,Value,Brackets);
+  Result:=SetToString(PropInfo^.PropType, Value, Brackets);
 end;
 end;
 
 
-Function SetToString(TypeInfo: PTypeInfo; Value: Integer; Brackets: Boolean) : String;
+Function SetToString(TypeInfo: PTypeInfo; Value: LongInt; Brackets: Boolean) : String;
+begin
+{$if defined(FPC_BIG_ENDIAN)}
+  { correctly adjust packed sets that are smaller than 32-bit }
+  case GetTypeData(TypeInfo)^.OrdType of
+    otSByte,otUByte: Value := Value shl (SizeOf(Integer)*8-8);
+    otSWord,otUWord: Value := Value shl (SizeOf(Integer)*8-16);
+  end;
+{$endif}
+  Result := SetToString(TypeInfo, @Value, Brackets);
+end;
 
 
+function SetToString(TypeInfo: PTypeInfo; Value: Pointer; Brackets: Boolean): String;
 type
 type
-  tsetarr = bitpacked array[0..SizeOf(Integer)*8-1] of 0..1;
+  tsetarr = bitpacked array[0..SizeOf(LongInt)*8-1] of 0..1;
 Var
 Var
-  I : Integer;
+  I,El,Els,Rem,V,Max : Integer;
   PTI : PTypeInfo;
   PTI : PTypeInfo;
-
+  PTD : PTypeData;
+  ValueArr : PLongInt;
 begin
 begin
-{$if defined(FPC_BIG_ENDIAN)}
-  { On big endian systems, set element 0 is in the most significant bit,
-    and the same goes for the elements of bitpacked arrays there.  }
-  case GetTypeData(TypeInfo)^.OrdType of
-    otSByte,otUByte: Value:=Value shl (SizeOf(Integer)*8-8);
-    otSWord,otUWord: Value:=Value shl (SizeOf(Integer)*8-16);
+  PTD := GetTypeData(TypeInfo);
+  PTI:=PTD^.CompType;
+  ValueArr := PLongInt(Value);
+  Result:='';
+{$ifdef ver3_0}
+  case PTD^.OrdType of
+    otSByte, otUByte: begin
+      Els := 0;
+      Rem := 1;
+    end;
+    otSWord, otUWord: begin
+      Els := 0;
+      Rem := 2;
+    end;
+    otSLong, otULong: begin
+      Els := 1;
+      Rem := 0;
+    end;
   end;
   end;
+{$else}
+  Els := PTD^.SetSize div SizeOf(LongInt);
+  Rem := PTD^.SetSize mod SizeOf(LongInt);
 {$endif}
 {$endif}
 
 
-  PTI:=GetTypeData(TypeInfo)^.CompType;
-  Result:='';
-  For I:=0 to SizeOf(Integer)*8-1 do
+{$ifdef ver3_0}
+  El := 0;
+{$else}
+  for El := 0 to (PTD^.SetSize - 1) div SizeOf(LongInt) do
+{$endif}
     begin
     begin
-      if (tsetarr(Value)[i]<>0) then
+      if El = Els then
+        Max := Rem
+      else
+        Max := SizeOf(LongInt);
+      For I:=0 to Max*8-1 do
         begin
         begin
-          If Result='' then
-            Result:=GetEnumName(PTI,i)
-          else
-            Result:=Result+','+GetEnumName(PTI,I);
+          if (tsetarr(ValueArr[El])[i]<>0) then
+            begin
+              V := I + SizeOf(LongInt) * 8 * El;
+              If Result='' then
+                Result:=GetEnumName(PTI,V)
+              else
+                Result:=Result+','+GetEnumName(PTI,V);
+            end;
         end;
         end;
     end;
     end;
   if Brackets then
   if Brackets then
     Result:='['+Result+']';
     Result:='['+Result+']';
 end;
 end;
 
 
-
-Function SetToString(PropInfo: PPropInfo; Value: Integer) : String;
+Function SetToString(PropInfo: PPropInfo; Value: LongInt) : String;
 
 
 begin
 begin
   Result:=SetToString(PropInfo,Value,False);
   Result:=SetToString(PropInfo,Value,False);
 end;
 end;
 
 
+function SetToString(PropInfo: PPropInfo; Value: Pointer; Brackets: Boolean): String;
+begin
+  Result := SetToString(PropInfo^.PropType, Value, Brackets);
+end;
 
 
 Const
 Const
   SetDelim = ['[',']',',',' '];
   SetDelim = ['[',']',',',' '];
@@ -1107,21 +1151,41 @@ begin
     end;
     end;
 end;
 end;
 
 
-Function StringToSet(PropInfo: PPropInfo; const Value: string): Integer;
+Function StringToSet(PropInfo: PPropInfo; const Value: string): LongInt;
 
 
 begin
 begin
   Result:=StringToSet(PropInfo^.PropType,Value);
   Result:=StringToSet(PropInfo^.PropType,Value);
 end;
 end;
 
 
-Function StringToSet(TypeInfo: PTypeInfo; const Value: string): Integer;
+Function StringToSet(TypeInfo: PTypeInfo; const Value: string): LongInt;
+begin
+  StringToSet(TypeInfo, Value, @Result);
+{$if defined(FPC_BIG_ENDIAN)}
+  { correctly adjust packed sets that are smaller than 32-bit }
+  case GetTypeData(TypeInfo)^.OrdType of
+    otSByte,otUByte: Result := Result shr (SizeOf(Integer)*8-8);
+    otSWord,otUWord: Result := Result shr (SizeOf(Integer)*8-16);
+  end;
+{$endif}
+end;
+
+procedure StringToSet(TypeInfo: PTypeInfo; const Value: String; Result: Pointer);
 Var
 Var
   S,T : String;
   S,T : String;
-  I : Integer;
+  I, ElOfs, BitOfs : Integer;
+  PTD: PTypeData;
   PTI : PTypeInfo;
   PTI : PTypeInfo;
+  ResArr: PLongWord;
 
 
 begin
 begin
-  Result:=0;
-  PTI:=GetTypeData(TypeInfo)^.Comptype;
+  PTD:=GetTypeData(TypeInfo);
+{$ifndef ver3_0}
+  FillChar(Result^, PTD^.SetSize, 0);
+{$else}
+  PInteger(Result)^ := 0;
+{$endif}
+  PTI:=PTD^.Comptype;
+  ResArr := PLongWord(Result);
   S:=Value;
   S:=Value;
   I:=1;
   I:=1;
   If Length(S)>0 then
   If Length(S)>0 then
@@ -1138,11 +1202,22 @@ begin
           I:=GetEnumValue(PTI,T);
           I:=GetEnumValue(PTI,T);
           if (I<0) then
           if (I<0) then
             raise EPropertyError.CreateFmt(SErrUnknownEnumValue, [T]);
             raise EPropertyError.CreateFmt(SErrUnknownEnumValue, [T]);
-          Result:=Result or (1 shl i);
+          ElOfs := I shr 5;
+          BitOfs := I and $1F;
+{$ifdef FPC_BIG_ENDIAN}
+          { on Big Endian systems enum values start from the MSB, thus we need
+            to reverse the shift }
+          BitOfs := 31 - BitOfs;
+{$endif}
+          ResArr[ElOfs] := ResArr[ElOfs] or (LongInt(1) shl BitOfs);
         end;
         end;
     end;
     end;
 end;
 end;
 
 
+procedure StringToSet(PropInfo: PPropInfo; const Value: String; Result: Pointer);
+begin
+  StringToSet(PropInfo^.PropType, Value, Result);
+end;
 
 
 Function AlignTypeData(p : Pointer) : Pointer;
 Function AlignTypeData(p : Pointer) : Pointer;
 {$packrecords c}
 {$packrecords c}

+ 10 - 3
rtl/os2/sysutils.pp

@@ -228,7 +228,13 @@ begin
 end;
 end;
 
 
 
 
-function FileExists (const FileName: RawByteString): boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+function FileExists (const FileName: RawByteString; FollowLink : Boolean): boolean;
 var
 var
   L: longint;
   L: longint;
 begin
 begin
@@ -349,6 +355,7 @@ begin
    OSErrorWatch (RC);
    OSErrorWatch (RC);
 end;
 end;
 
 
+
 function FileGetDate (Handle: THandle): longint;
 function FileGetDate (Handle: THandle): longint;
 var
 var
   FStat: TFileStatus3;
   FStat: TFileStatus3;
@@ -515,7 +522,7 @@ begin
 end;
 end;
 
 
 
 
-function DirectoryExists (const Directory: RawByteString): boolean;
+function DirectoryExists (const Directory: RawByteString; FollowLink : Boolean): boolean;
 var
 var
   L: longint;
   L: longint;
 begin
 begin
@@ -996,6 +1003,6 @@ Initialization
   LastOSError := 0;
   LastOSError := 0;
   OrigOSErrorWatch := TOSErrorWatch (SetOSErrorTracking (@TrackLastOSError));
   OrigOSErrorWatch := TOSErrorWatch (SetOSErrorTracking (@TrackLastOSError));
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/symbian/sysutils.pp

@@ -135,7 +135,13 @@ begin
 end;
 end;
 
 
 
 
-Function FileExists (Const FileName : RawByteString) : Boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+Function FileExists (Const FileName : RawByteString; FollowLink : Boolean) : Boolean;
 Begin
 Begin
   result := false;
   result := false;
 end;
 end;
@@ -191,7 +197,7 @@ Begin
 End;
 End;
 
 
 
 
-function DirectoryExists(const Directory: RawByteString): Boolean;
+function DirectoryExists(const Directory: RawByteString; FollowLink : Boolean): Boolean;
 begin
 begin
   result := false;
   result := false;
 end;
 end;
@@ -285,6 +291,6 @@ end;
 Initialization
 Initialization
   InitExceptions;
   InitExceptions;
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 61 - 20
rtl/unix/sysutils.pp

@@ -609,25 +609,6 @@ begin
 end;
 end;
 
 
 
 
-Function FileExists (Const FileName : RawByteString) : Boolean;
-var
-  SystemFileName: RawByteString;
-begin
-  SystemFileName:=ToSingleByteFileSystemEncodedFileName(FileName);
-  // Don't use stat. It fails on files >2 GB.
-  // Access obeys the same access rules, so the result should be the same.
-  FileExists:=fpAccess(pointer(SystemFileName),F_OK)=0;
-end;
-
-Function DirectoryExists (Const Directory : RawByteString) : Boolean;
-Var
-  Info : Stat;
-  SystemFileName: RawByteString;
-begin
-  SystemFileName:=ToSingleByteFileSystemEncodedFileName(Directory);
-  DirectoryExists:=(fpstat(pointer(SystemFileName),Info)>=0) and fpS_ISDIR(Info.st_mode);
-end;
-
 Function LinuxToWinAttr (const FN : RawByteString; Const Info : Stat) : Longint;
 Function LinuxToWinAttr (const FN : RawByteString; Const Info : Stat) : Longint;
 Var
 Var
   LinkInfo : Stat;
   LinkInfo : Stat;
@@ -655,6 +636,66 @@ begin
 end;
 end;
 
 
 
 
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+var
+  Info : Stat;
+  SystemFileName: RawByteString;
+begin
+  SystemFileName:=ToSingleByteFileSystemEncodedFileName(FileName);
+  if (fplstat(SystemFileName,Info)>=0) and fpS_ISLNK(Info.st_mode) then begin
+    FillByte(SymLinkRec, SizeOf(SymLinkRec), 0);
+    SymLinkRec.TargetName:=fpreadlink(SystemFileName);
+    if fpstat(pointer(SystemFileName), Info) < 0 then
+      raise EDirectoryNotFoundException.Create(SysErrorMessage(GetLastOSError));
+    SymLinkRec.Attr := LinuxToWinAttr(SystemFileName, Info);
+    SymLinkRec.Size := Info.st_size;
+    SymLinkRec.Mode := Info.st_mode;
+    Result:=True;
+  end else
+    Result:=False;
+end;
+
+
+Function FileExists (Const FileName : RawByteString; FollowLink : Boolean) : Boolean;
+var
+  Info : Stat;
+  SystemFileName: RawByteString;
+  isdir: Boolean;
+begin
+  SystemFileName:=ToSingleByteFileSystemEncodedFileName(FileName);
+  // Don't use stat. It fails on files >2 GB.
+  // Access obeys the same access rules, so the result should be the same.
+  FileExists:=fpAccess(pointer(SystemFileName),F_OK)=0;
+  { we need to ensure however that we aren't dealing with a directory }
+  isdir:=False;
+  if FileExists then begin
+    if (fpstat(pointer(SystemFileName),Info)>=0) and fpS_ISDIR(Info.st_mode) then begin
+      FileExists:=False;
+      isdir:=True;
+    end;
+  end;
+  { if we shall not follow the link we only need to check for a symlink if the
+    target file itself should not exist }
+  if not FileExists and not isdir and not FollowLink then
+    FileExists:=(fplstat(pointer(SystemFileName),Info)>=0) and fpS_ISLNK(Info.st_mode);
+end;
+
+Function DirectoryExists (Const Directory : RawByteString; FollowLink : Boolean) : Boolean;
+Var
+  Info : Stat;
+  SystemFileName: RawByteString;
+  exists: Boolean;
+begin
+  SystemFileName:=ToSingleByteFileSystemEncodedFileName(Directory);
+  exists:=fpstat(pointer(SystemFileName),Info)>=0;
+  DirectoryExists:=exists and fpS_ISDIR(Info.st_mode);
+  { if we shall not follow the link we only need to check for a symlink if the
+    target directory itself should not exist }
+  if not exists and not FollowLink then
+    DirectoryExists:=(fplstat(pointer(SystemFileName),Info)>=0) and fpS_ISLNK(Info.st_mode);
+end;
+
+
 { assumes that pattern and name have the same code page }
 { assumes that pattern and name have the same code page }
 Function FNMatch(const Pattern,Name:string):Boolean;
 Function FNMatch(const Pattern,Name:string):Boolean;
 Var
 Var
@@ -1657,6 +1698,6 @@ Initialization
 
 
 Finalization
 Finalization
   FreeDriveStr;
   FreeDriveStr;
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/watcom/sysutils.pp

@@ -295,7 +295,13 @@ begin
 end;
 end;
 
 
 
 
-function FileExists (const FileName: RawByteString): boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+function FileExists (const FileName: RawByteString; FollowLink : Boolean): boolean;
 var
 var
   L: longint;
   L: longint;
 begin
 begin
@@ -311,7 +317,7 @@ begin
 end;
 end;
 
 
 
 
-function DirectoryExists (const Directory: RawByteString): boolean;
+function DirectoryExists (const Directory: RawByteString; FollowLink : Boolean): boolean;
 var
 var
   L: longint;
   L: longint;
 begin
 begin
@@ -892,6 +898,6 @@ Initialization
   InitInternational;    { Initialize internationalization settings }
   InitInternational;    { Initialize internationalization settings }
   InitDelay;
   InitDelay;
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/wii/sysutils.pp

@@ -144,7 +144,13 @@ begin
 end;
 end;
 
 
 
 
-Function FileExists (Const FileName : RawByteString) : Boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+Function FileExists (Const FileName : RawByteString; FollowLink : Boolean) : Boolean;
 Begin
 Begin
   result := false;
   result := false;
 end;
 end;
@@ -202,7 +208,7 @@ Begin
 End;
 End;
 
 
 
 
-function DirectoryExists(const Directory: RawByteString): Boolean;
+function DirectoryExists(const Directory: RawByteString; FollowLink : Boolean): Boolean;
 begin
 begin
   result := false;
   result := false;
 end;
 end;
@@ -288,6 +294,6 @@ end;
 Initialization
 Initialization
   InitExceptions;
   InitExceptions;
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 155 - 16
rtl/win/sysutils.pp

@@ -92,6 +92,10 @@ implementation
     sysconst,
     sysconst,
     windirs;
     windirs;
 
 
+var 
+  FindExInfoDefaults : TFINDEX_INFO_LEVELS = FindExInfoStandard;
+  FindFirstAdditionalFlags : DWord = 0;
+
 function WinCheck(res:boolean):boolean;
 function WinCheck(res:boolean):boolean;
   begin
   begin
     if not res then
     if not res then
@@ -407,28 +411,157 @@ begin
 end;
 end;
 
 
 
 
-Function FileExists (Const FileName : UnicodeString) : Boolean;
+function FileGetSymLinkTargetInt(const FileName: UnicodeString; out SymLinkRec: TUnicodeSymLinkRec; RaiseErrorOnMissing: Boolean): Boolean;
+{ reparse point specific declarations from Windows headers }
+const
+  IO_REPARSE_TAG_MOUNT_POINT = $A0000003;
+  IO_REPARSE_TAG_SYMLINK = $A000000C;
+  ERROR_REPARSE_TAG_INVALID = 4393;
+  FSCTL_GET_REPARSE_POINT = $900A8;
+  MAXIMUM_REPARSE_DATA_BUFFER_SIZE = 16 * 1024;
+  SYMLINK_FLAG_RELATIVE = 1;
+  FILE_FLAG_OPEN_REPARSE_POINT = $200000;
+  FILE_READ_EA = $8;
+type
+  TReparseDataBuffer = record
+    ReparseTag: ULONG;
+    ReparseDataLength: Word;
+    Reserved: Word;
+    SubstituteNameOffset: Word;
+    SubstituteNameLength: Word;
+    PrintNameOffset: Word;
+    PrintNameLength: Word;
+    case ULONG of
+      IO_REPARSE_TAG_MOUNT_POINT: (
+        PathBufferMount: array[0..4095] of WCHAR);
+      IO_REPARSE_TAG_SYMLINK: (
+        Flags: ULONG;
+        PathBufferSym: array[0..4095] of WCHAR);
+  end;
+
+const
+  CShareAny = FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE;
+  COpenReparse = FILE_FLAG_OPEN_REPARSE_POINT or FILE_FLAG_BACKUP_SEMANTICS;
 var
 var
-  Attr:Dword;
+  HFile, Handle: THandle;
+  PBuffer: ^TReparseDataBuffer;
+  BytesReturned: DWORD;
 begin
 begin
+  SymLinkRec := Default(TUnicodeSymLinkRec);
 
 
-  Attr:=GetFileAttributesW(PWideChar(FileName));
-  if Attr <> $ffffffff then
-    Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0
-  else
-    Result:=False;
+  HFile := CreateFileW(PUnicodeChar(FileName), FILE_READ_EA, CShareAny, Nil, OPEN_EXISTING, COpenReparse, 0);
+  if HFile <> INVALID_HANDLE_VALUE then
+    try
+      GetMem(PBuffer, MAXIMUM_REPARSE_DATA_BUFFER_SIZE);
+      try
+        if DeviceIoControl(HFile, FSCTL_GET_REPARSE_POINT, Nil, 0,
+             PBuffer, MAXIMUM_REPARSE_DATA_BUFFER_SIZE, @BytesReturned, Nil) then begin
+          case PBuffer^.ReparseTag of
+            IO_REPARSE_TAG_MOUNT_POINT: begin
+              SymLinkRec.TargetName := WideCharLenToString(
+                @PBuffer^.PathBufferMount[4 { skip start '\??\' } +
+                  PBuffer^.SubstituteNameOffset div SizeOf(WCHAR)],
+                PBuffer^.SubstituteNameLength div SizeOf(WCHAR) - 4);
+            end;
+            IO_REPARSE_TAG_SYMLINK: begin
+              SymLinkRec.TargetName := WideCharLenToString(
+                @PBuffer^.PathBufferSym[PBuffer^.PrintNameOffset div SizeOf(WCHAR)],
+                PBuffer^.PrintNameLength div SizeOf(WCHAR));
+              if (PBuffer^.Flags and SYMLINK_FLAG_RELATIVE) <> 0 then
+                SymLinkRec.TargetName := ExpandFileName(ExtractFilePath(FileName) + SymLinkRec.TargetName);
+            end;
+          end;
+
+          Handle := FindFirstFileExW(PUnicodeChar(SymLinkRec.TargetName), FindExInfoDefaults , @SymLinkRec.FindData,
+                      FindExSearchNameMatch, Nil, 0);
+          if Handle <> INVALID_HANDLE_VALUE then begin
+            Windows.FindClose(Handle);
+            SymLinkRec.Attr := SymLinkRec.FindData.dwFileAttributes;
+            SymLinkRec.Size := QWord(SymLinkRec.FindData.nFileSizeHigh) shl 32 + QWord(SymLinkRec.FindData.nFileSizeLow);
+          end else if RaiseErrorOnMissing then
+            raise EDirectoryNotFoundException.Create(SysErrorMessage(GetLastOSError))
+          else
+            SymLinkRec.TargetName := '';
+        end else
+          SetLastError(ERROR_REPARSE_TAG_INVALID);
+      finally
+        FreeMem(PBuffer);
+      end;
+    finally
+      CloseHandle(HFile);
+    end;
+  Result := SymLinkRec.TargetName <> '';
+end;
+
+
+function FileGetSymLinkTarget(const FileName: UnicodeString; out SymLinkRec: TUnicodeSymLinkRec): Boolean;
+begin
+  Result := FileGetSymLinkTargetInt(FileName, SymLinkRec, True);
 end;
 end;
 
 
 
 
-Function DirectoryExists (Const Directory : UnicodeString) : Boolean;
+function FileOrDirExists(const FileOrDirName: UnicodeString; CheckDir: Boolean; FollowLink: Boolean): Boolean;
+const
+  CDirAttributes: array[Boolean] of DWORD = (0, FILE_ATTRIBUTE_DIRECTORY);
+
+  function FoundByEnum: Boolean;
+  var
+    FindData: TWin32FindDataW;
+    Handle: THandle;
+  begin
+    { FindFirstFileEx is faster than FindFirstFile }
+    Handle := FindFirstFileExW(PUnicodeChar(FileOrDirName), FindExInfoDefaults , @FindData,
+                FindExSearchNameMatch, Nil, 0);
+    Result := Handle <> INVALID_HANDLE_VALUE;
+    if Result then begin
+      Windows.FindClose(Handle);
+      Result := (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = CDirAttributes[CheckDir];
+    end;
+  end;
+
+  function LinkFileExists: Boolean;
+  var
+    slr: TUnicodeSymLinkRec;
+  begin
+    Result := FileGetSymLinkTargetInt(FileOrDirName, slr, False) and
+                FileOrDirExists(slr.TargetName, CheckDir, False);
+  end;
+
+const
+  CNotExistsErrors = [
+    ERROR_FILE_NOT_FOUND,
+    ERROR_PATH_NOT_FOUND,
+    ERROR_INVALID_NAME, // protects from names in the form of masks like '*'
+    ERROR_INVALID_DRIVE,
+    ERROR_NOT_READY,
+    ERROR_INVALID_PARAMETER,
+    ERROR_BAD_PATHNAME,
+    ERROR_BAD_NETPATH,
+    ERROR_BAD_NET_NAME
+  ];
 var
 var
-  Attr:Dword;
+  Attr : DWord;
+begin
+  Attr := GetFileAttributesW(PUnicodeChar(FileOrDirName));
+  if Attr = INVALID_FILE_ATTRIBUTES then
+    Result := not (GetLastError in CNotExistsErrors) and FoundByEnum
+  else begin
+    Result := (Attr and FILE_ATTRIBUTE_DIRECTORY) = CDirAttributes[CheckDir];
+    if Result and FollowLink and ((Attr and FILE_ATTRIBUTE_REPARSE_POINT) <> 0) then
+      Result := LinkFileExists;
+  end;
+end;
+
+
+Function FileExists (Const FileName : UnicodeString; FollowLink : Boolean) : Boolean;
 begin
 begin
-  Attr:=GetFileAttributesW(PWideChar(Directory));
-  if Attr <> $ffffffff then
-    Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) > 0
-  else
-    Result:=False;
+  Result := FileOrDirExists(FileName, False, FollowLink);
+end;
+
+
+Function DirectoryExists (Const Directory : UnicodeString; FollowLink : Boolean) : Boolean;
+begin
+  Result := FileOrDirExists(Directory, True, FollowLink);
 end;
 end;
 
 
 Function FindMatch(var f: TAbstractSearchRec; var Name: UnicodeString) : Longint;
 Function FindMatch(var f: TAbstractSearchRec; var Name: UnicodeString) : Longint;
@@ -466,7 +599,9 @@ begin
   Rslt.ExcludeAttr:=(not Attr) and ($1e);
   Rslt.ExcludeAttr:=(not Attr) and ($1e);
                  { $1e = faHidden or faSysFile or faVolumeID or faDirectory }
                  { $1e = faHidden or faSysFile or faVolumeID or faDirectory }
   { FindFirstFile is a Win32 Call }
   { FindFirstFile is a Win32 Call }
-  Rslt.FindHandle:=FindFirstFileW (PWideChar(Path),Rslt.FindData);
+  Rslt.FindHandle:=FindFirstFileExW(PUnicodeChar(Path), FindExInfoDefaults , @Rslt.FindData,
+                      FindExSearchNameMatch, Nil, FindFirstAdditionalFlags);
+
   If Rslt.FindHandle=Invalid_Handle_value then
   If Rslt.FindHandle=Invalid_Handle_value then
    begin
    begin
      Result:=GetLastError;
      Result:=GetLastError;
@@ -1265,6 +1400,10 @@ begin
   kernel32dll:=GetModuleHandle('kernel32');
   kernel32dll:=GetModuleHandle('kernel32');
   if kernel32dll<>0 then
   if kernel32dll<>0 then
     GetDiskFreeSpaceEx:=TGetDiskFreeSpaceEx(GetProcAddress(kernel32dll,'GetDiskFreeSpaceExA'));
     GetDiskFreeSpaceEx:=TGetDiskFreeSpaceEx(GetProcAddress(kernel32dll,'GetDiskFreeSpaceExA'));
+  if Win32MajorVersion<6 then
+     FindExInfoDefaults := FindExInfoStandard; // also searches SFNs. XP only.
+  if (Win32MajorVersion>=6) and (Win32MinorVersion>=1) then 
+    FindFirstAdditionalFlags := FIND_FIRST_EX_LARGE_FETCH; // win7 and 2008R2+
 end;
 end;
 
 
 Function GetAppConfigDir(Global : Boolean) : String;
 Function GetAppConfigDir(Global : Boolean) : String;
@@ -1527,6 +1666,6 @@ Initialization
   InitSysConfigDir;
   InitSysConfigDir;
   OnBeep:=@SysBeep;
   OnBeep:=@SysBeep;
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/win16/sysutils.pp

@@ -329,7 +329,13 @@ begin
 end;
 end;
 
 
 
 
-function FileExists (const FileName: RawByteString): boolean;
+function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+function FileExists (const FileName: RawByteString; FollowLink : Boolean): boolean;
 var
 var
   L: longint;
   L: longint;
 begin
 begin
@@ -344,7 +350,7 @@ begin
 end;
 end;
 
 
 
 
-Function DirectoryExists (Const Directory : RawByteString) : Boolean;
+Function DirectoryExists (Const Directory : RawByteString; FollowLink : Boolean) : Boolean;
 Var
 Var
   Dir : RawByteString;
   Dir : RawByteString;
   drive : byte;
   drive : byte;
@@ -945,6 +951,6 @@ Initialization
   InitInternational;    { Initialize internationalization settings }
   InitInternational;    { Initialize internationalization settings }
   OnBeep:=@SysBeep;
   OnBeep:=@SysBeep;
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 end.
 end.

+ 9 - 3
rtl/wince/sysutils.pp

@@ -267,7 +267,13 @@ begin
 end;
 end;
 
 
 
 
-Function FileExists (Const FileName : UnicodeString) : Boolean;
+function FileGetSymLinkTarget(const FileName: UnicodeString; out SymLinkRec: TUnicodeSymLinkRec): Boolean;
+begin
+  Result := False;
+end;
+
+
+Function FileExists (Const FileName : UnicodeString; FollowLink : Boolean) : Boolean;
 var
 var
   Attr:Dword;
   Attr:Dword;
 begin
 begin
@@ -279,7 +285,7 @@ begin
 end;
 end;
 
 
 
 
-Function DirectoryExists (Const Directory : UnicodeString) : Boolean;
+Function DirectoryExists (Const Directory : UnicodeString; FollowLink : Boolean) : Boolean;
 var
 var
   Attr:Dword;
   Attr:Dword;
 begin
 begin
@@ -976,7 +982,7 @@ Initialization
   SysConfigDir:='\Windows';
   SysConfigDir:='\Windows';
 
 
 Finalization
 Finalization
-  DoneExceptions;
   FreeTerminateProcs;
   FreeTerminateProcs;
+  DoneExceptions;
 
 
 end.
 end.

+ 184 - 0
tests/test/trtti20.pp

@@ -0,0 +1,184 @@
+program trtti20;
+
+{$mode objfpc}
+
+uses
+  TypInfo;
+
+type
+  TByteEnum = (
+    be1,
+    be2,
+    be3,
+    be4,
+    be5,
+    be6
+  );
+
+  TWordEnum = (
+    we1,
+    we2,
+    we3,
+    we4,
+    we5,
+    we6,
+    we7,
+    we8,
+    we9,
+    we10
+  );
+
+  TDWordEnum = (
+    de1,
+    de2,
+    de3,
+    de4,
+    de5,
+    de6,
+    de7,
+    de8,
+    de9,
+    de10,
+    de11,
+    de12,
+    de13,
+    de14,
+    de15,
+    de16,
+    de17,
+    de18,
+    de19,
+    de20
+  );
+
+  TLargeEnum = (
+    le1,
+    le2,
+    le3,
+    le4,
+    le5,
+    le6,
+    le7,
+    le8,
+    le9,
+    le10,
+    le11,
+    le12,
+    le13,
+    le14,
+    le15,
+    le16,
+    le17,
+    le18,
+    le19,
+    le20,
+    le21,
+    le22,
+    le23,
+    le24,
+    le25,
+    le26,
+    le27,
+    le28,
+    le29,
+    le30,
+    le31,
+    le32,
+    le33,
+    le34,
+    le35,
+    le36,
+    le37,
+    le38,
+    le39,
+    le40
+  );
+
+  TByteSet = set of TByteEnum;
+  TWordSet = set of TWordEnum;
+  TDWordSet = set of TDWordEnum;
+  TLargeSet = set of TLargeEnum;
+
+{$push}
+{$packset 1}
+  TByteSetP = set of TByteEnum;
+  TWordSetP = set of TWordEnum;
+  TDWordSetP = set of TDWordEnum;
+  TLargeSetP = set of TLargeEnum;
+{$pop}
+
+const
+  StrBS = '[be1,be6]';
+  StrWS = '[we1,we8,we10]';
+  StrDS = '[de1,de7,de20]';
+  StrLS = '[le1,le20,le31,le40]';
+
+var
+  bs1, bs2: TByteSet;
+  ws1, ws2: TWordSet;
+  ds1, ds2: TDWordSet;
+  ls1, ls2: TLargeSet;
+  bsp1, bsp2: TByteSetP;
+  wsp1, wsp2: TWordSetP;
+  dsp1, dsp2: TDWordSetP;
+  lsp1, lsp2: TLargeSetP;
+begin
+  bs1 := [be1, be6];
+  ws1 := [we1, we8, we10];
+  ds1 := [de1, de7, de20];
+  ls1 := [le1, le20, le31, le40];
+  bsp1 := [be1, be6];
+  wsp1 := [we1, we8, we10];
+  dsp1 := [de1, de7, de20];
+  lsp1 := [le1, le20, le31, le40];
+
+  if SetToString(PTypeInfo(TypeInfo(TByteSet)), @bs1, True) <> StrBS then
+    Halt(1);
+  if SetToString(PTypeInfo(TypeInfo(TWordSet)), @ws1, True) <> StrWS then
+    Halt(2);
+  if SetToString(PTypeInfo(TypeInfo(TDWordSet)), @ds1, True) <> StrDS then
+    Halt(3);
+  if SetToString(PTypeInfo(TypeInfo(TLargeSet)), @ls1, True) <> StrLS then
+    Halt(4);
+
+  if SetToString(PTypeInfo(TypeInfo(TByteSetP)), @bsp1, True) <> StrBS then
+    Halt(5);
+  if SetToString(PTypeInfo(TypeInfo(TWordSetP)), @wsp1, True) <> StrWS then
+    Halt(6);
+  if SetToString(PTypeInfo(TypeInfo(TDWordSetP)), @dsp1, True) <> StrDS then
+    Halt(7);
+  if SetToString(PTypeInfo(TypeInfo(TLargeSetP)), @lsp1, True) <> StrLS then
+    Halt(8);
+
+  StringToSet(PTypeInfo(TypeInfo(TByteSet)), StrBS, @bs2);
+  if bs2<>bs1 then
+    Halt(9);
+
+  StringToSet(PTypeInfo(TypeInfo(TWordSet)), StrWS, @ws2);
+  if ws2<>ws1 then
+    Halt(10);
+
+  StringToSet(PTypeInfo(TypeInfo(TDWordSet)), StrDS, @ds2);
+  if ds2<>ds1 then
+    Halt(11);
+
+  StringToSet(PTypeInfo(TypeInfo(TLargeSet)), StrLS, @ls2);
+  if ls2<>ls1 then
+    Halt(12);
+
+  StringToSet(PTypeInfo(TypeInfo(TByteSetP)), StrBS, @bsp2);
+  if bsp2<>bsp1 then
+    Halt(9);
+
+  StringToSet(PTypeInfo(TypeInfo(TWordSetP)), StrWS, @wsp2);
+  if wsp2<>wsp1 then
+    Halt(10);
+
+  StringToSet(PTypeInfo(TypeInfo(TDWordSetP)), StrDS, @dsp2);
+  if dsp2<>dsp1 then
+    Halt(11);
+
+  StringToSet(PTypeInfo(TypeInfo(TLargeSetP)), StrLS, @lsp2);
+  if lsp2<>lsp1 then
+    Halt(12);
+end.

+ 81 - 0
tests/webtbs/tw35027.pp

@@ -0,0 +1,81 @@
+program tw35027;
+{$mode objfpc}{$H+}
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF}
+  Classes, sysutils, syncobjs;
+
+type
+  MT1= class(TThread)
+    procedure Execute; override;
+  private
+    procedure MySync;
+  end;
+
+  { MT2 }
+
+  MT2= class(TThread)
+    procedure Execute; override;
+  private
+    procedure MySync2;
+  end;
+var
+  E1, E2, E3: TEventObject;
+  T1: MT1;
+  T2: MT2;
+  MT1Count, MT2Count: Integer;
+
+{ MT2 }
+
+procedure MT2.Execute;
+begin
+  E1.WaitFor(INFINITE);
+  Sleep(100);
+  try
+    Synchronize(@MySync2);
+  except end;
+end;
+
+procedure MT2.MySync2;
+begin
+  Inc(MT2Count);
+  writeln('x2 ');
+  raise Exception.Create('Foo'); // prevent event^.Method from being set to nil
+end;
+
+procedure MT1.Execute;
+begin
+  E1.SetEvent;
+  try
+    Synchronize(@MySync);
+  except end;
+  E3.SetEvent;
+  E2.WaitFor(INFINITE);
+  try
+    Synchronize(@MySync);
+  except end;
+end;
+
+procedure MT1.MySync;
+begin
+  Inc(MT1Count);
+  writeln('x');
+  raise Exception.Create('Foo'); // prevent event^.Next from being set to nil
+end;
+
+begin
+  E1 := TEvent.Create(Nil, False, False, '');
+  E2 := TEvent.Create(Nil, False, False, '');
+  E3 := TEvent.Create(Nil, False, False, '');
+  T1 := MT1.Create(False);
+  T2 := MT2.Create(False);
+  Sleep(2000);
+  CheckSynchronize(1000);
+  CheckSynchronize(1000);
+  E3.WaitFor(INFINITE);
+  E2.SetEvent;
+  CheckSynchronize(1000);
+  CheckSynchronize(1000);
+  if (MT1Count <> 2) or (MT2Count <> 1) then
+    Halt(1);
+  Writeln('ok');
+end.

+ 31 - 0
tests/webtbs/tw35028.pp

@@ -0,0 +1,31 @@
+{ %OPT=-gh }
+
+program tw35028;
+
+{$mode objfpc}
+
+uses
+{$ifdef unix}
+  cthreads,
+{$endif}
+  Classes;
+
+type
+  TTest = class
+    procedure Test;
+  end;
+
+procedure TTest.Test;
+begin
+  raise TObject.Create;
+end;
+
+var
+  t: TTest;
+begin
+  HaltOnNotReleased := True;
+  try
+    TThread.Queue(Nil, @t.Test);
+  except
+  end;
+end.