diff options
author | svenbarth <svenbarth@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2020-12-13 21:52:13 +0000 |
---|---|---|
committer | svenbarth <svenbarth@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2020-12-13 21:52:13 +0000 |
commit | 7326082c16e05468ec156cb0f8e824fa41c543af (patch) | |
tree | 9b964580ef167c6b369fb4e31a86eedf635a92ae | |
parent | f47d6c2b80865013c1d457ca7060298a475fb2b5 (diff) | |
download | fpc-7326082c16e05468ec156cb0f8e824fa41c543af.tar.gz |
Merged revision(s) 44256-44257, 44746, 45329 from trunk:
* fix for Mantis #36706: only link a library against the dynamic loader if we're not linking against the C library anyway
Note: I did not yet find a case where we *do* need to link a library against the loader; this will have to be investigated further, but for 3.2.0 this is safest
........
* fix for Mantis #36738: when copying a record using its copy operator we assume that we've copied the whole record; this way managed records inside non-managed records are handled correctly
+ added (adjusted) test
........
* when checking for an existing operator overload for the assignment operator, check for the correct variant (explicit or not) matching the overload
+ added tests
........
* GetLoadErrorStr (currently) returns a ShortString, so avoid a useless conversion to AnsiString
........
git-svn-id: https://svn.freepascal.org/svn/fpc/branches/fixes_3_2@47771 3ad0048d-3df7-0310-abae-a5850022a9f2
-rw-r--r-- | compiler/htypechk.pas | 6 | ||||
-rw-r--r-- | compiler/systems/t_linux.pas | 2 | ||||
-rw-r--r-- | rtl/inc/rtti.inc | 5 | ||||
-rw-r--r-- | rtl/win/sysdl.inc | 2 | ||||
-rw-r--r-- | tests/test/toperator89.pp | 16 | ||||
-rw-r--r-- | tests/test/toperator90.pp | 16 | ||||
-rw-r--r-- | tests/webtbs/tw36738.pp | 111 |
7 files changed, 154 insertions, 4 deletions
diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 08742c1c8a..ebe33104bc 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -615,6 +615,7 @@ implementation i : longint; eq : tequaltype; conv : tconverttype; + cdo : tcompare_defs_options; pd : tprocdef; oldcount, count: longint; @@ -660,7 +661,10 @@ implementation { assignment is a special case } if optoken in [_ASSIGNMENT,_OP_EXPLICIT] then begin - eq:=compare_defs_ext(ld,pf.returndef,nothingn,conv,pd,[cdo_explicit]); + cdo:=[]; + if optoken=_OP_EXPLICIT then + include(cdo,cdo_explicit); + eq:=compare_defs_ext(ld,pf.returndef,nothingn,conv,pd,cdo); result:= (eq=te_exact) or ( diff --git a/compiler/systems/t_linux.pas b/compiler/systems/t_linux.pas index c0b3648f93..ac7c74d804 100644 --- a/compiler/systems/t_linux.pas +++ b/compiler/systems/t_linux.pas @@ -548,7 +548,7 @@ begin { Write sharedlibraries like -l<lib>, also add the needed dynamic linker here to be sure that it gets linked this is needed for glibc2 systems (PFV) } - if (isdll) then + if isdll and not linklibc then begin Add('INPUT('); Add(sysrootpath+info.DynamicLinker); diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc index 46cae4c2dd..2abc18685f 100644 --- a/rtl/inc/rtti.inc +++ b/rtl/inc/rtti.inc @@ -397,7 +397,10 @@ begin {$endif VER3_0} {$ifndef VER3_0} if Assigned(recordop) and Assigned(recordop^.Copy) then - recordop^.Copy(Src,Dest) + begin + recordop^.Copy(Src,Dest); + Result:=PRecordInfoFull(Temp)^.Size; + end else begin Result:=Size; diff --git a/rtl/win/sysdl.inc b/rtl/win/sysdl.inc index 2bc680a674..5a2c918b23 100644 --- a/rtl/win/sysdl.inc +++ b/rtl/win/sysdl.inc @@ -59,7 +59,7 @@ begin MakeLangId(LANG_NEUTRAL, SUBLANG_DEFAULT), @temp[1], 255,nil); SetLength(temp,c); - Result:=AnsiString(temp); + Result:=String(temp); end; const diff --git a/tests/test/toperator89.pp b/tests/test/toperator89.pp new file mode 100644 index 0000000000..e73448cac9 --- /dev/null +++ b/tests/test/toperator89.pp @@ -0,0 +1,16 @@ +{ %NORUN } + +program toperator89; + +{$mode objfpc}{$H+} + +{ overloading the implicit assignment is allowed } + +operator := (aArg: LongInt): Boolean; +begin + Result := aArg <> 0; +end; + +begin + +end. diff --git a/tests/test/toperator90.pp b/tests/test/toperator90.pp new file mode 100644 index 0000000000..1a6a044fce --- /dev/null +++ b/tests/test/toperator90.pp @@ -0,0 +1,16 @@ +{ %FAIL } + +program toperator90; + +{$mode objfpc}{$H+} + +{ overloading the explicit assignment is NOT allowed } + +operator Explicit (aArg: LongInt): Boolean; +begin + Result := aArg <> 0; +end; + +begin + +end. diff --git a/tests/webtbs/tw36738.pp b/tests/webtbs/tw36738.pp new file mode 100644 index 0000000000..4e3ddd3291 --- /dev/null +++ b/tests/webtbs/tw36738.pp @@ -0,0 +1,111 @@ +program tw36738; + +{$mode objfpc} +{$modeswitch advancedrecords} + +uses + SysUtils; + +type + + TMyManagedRec = record + Field1: Integer; + Field2: Int64; + class operator Initialize(var r: TMyManagedRec); + class operator Copy(constref aSrc: TMyManagedRec; var aDst: TMyManagedRec); + end; + + generic TGenericRec<T> = record + SomeField: Integer; + GenField: T; + end; + + TSimpleRec = record + SomeField: Integer; + MngField: TMyManagedRec; + end; + + TMyRecSpec = specialize TGenericRec<TMyManagedRec>; + +class operator TMyManagedRec.Initialize(var r: TMyManagedRec); +begin + r.Field1 := 101; + r.Field2 := 1001; +end; + +class operator TMyManagedRec.Copy(constref aSrc: TMyManagedRec; var aDst: TMyManagedRec); +begin + if @aSrc <> @aDst then + begin + aDst.Field1 := aSrc.Field1 + 100; + aDst.Field2 := aSrc.Field2 + 1000; + Writeln(aDst.Field1); + Writeln(aDst.Field2); + end; +end; + +var + MyGenRec, MyGenRec2: TMyRecSpec; + MyRec, MyRec2: TSimpleRec; + +begin + if IsManagedType(TMyRecSpec) then + begin + WriteLn('Yes, TMyRecSpec is a managed type'); + WriteLn('MyGenRec.GenField.Field1 = ', MyGenRec.GenField.Field1); + if MyGenRec.GenField.Field1 <> 101 then + Halt(1); + WriteLn('MyGenRec.GenField.Field2 = ', MyGenRec.GenField.Field2); + if MyGenRec.GenField.Field2 <> 1001 then + Halt(2); + WriteLn('MyGenRec2.GenField.Field1 = ', MyGenRec2.GenField.Field1); + if MyGenRec2.GenField.Field1 <> 101 then + Halt(3); + WriteLn('MyGenRec2.GenField.Field2 = ', MyGenRec2.GenField.Field2); + if MyGenRec2.GenField.Field2 <> 1001 then + Halt(4); + MyGenRec2 := MyGenRec; + WriteLn('MyGenRec2.GenField.Field1 = ', MyGenRec2.GenField.Field1); + if MyGenRec2.GenField.Field1 <> 201 then + Halt(5); + WriteLn('MyGenRec2.GenField.Field2 = ', MyGenRec2.GenField.Field2); + if MyGenRec2.GenField.Field2 <> 2001 then + Halt(6); + end + else begin + WriteLn('No, TMyRecSpec is not a managed type'); + Halt(7); + end; + + WriteLn; + + if IsManagedType(TSimpleRec) then + begin + WriteLn('Yes, TSimpleRec is a managed type'); + WriteLn('MyRec.MngField.Field1 = ', MyRec.MngField.Field1); + if MyRec.MngField.Field1 <> 101 then + Halt(8); + WriteLn('MyRec.MngField.Field2 = ', MyRec.MngField.Field2); + if MyRec.MngField.Field2 <> 1001 then + Halt(9); + WriteLn('MyRec2.MngField.Field1 = ', MyRec2.MngField.Field1); + if MyRec2.MngField.Field1 <> 101 then + Halt(10); + WriteLn('MyRec2.MngField.Field2 = ', MyRec2.MngField.Field2); + if MyRec.MngField.Field2 <> 1001 then + Halt(11); + MyRec2 := MyRec; + WriteLn('MyRec2.MngField.Field1 = ', MyRec2.MngField.Field1); + if MyRec2.MngField.Field1 <> 201 then + Halt(12); + WriteLn('MyRec2.MngField.Field2 = ', MyRec2.MngField.Field2); + if MyRec2.MngField.Field2 <> 2001 then + Halt(13); + end + else begin + WriteLn('No, TSimpleRec is not a managed type'); + Halt(14); + end; + //ReadLn; + Writeln('ok'); +end. |