diff --git a/.gitattributes b/.gitattributes index 8f8d933835..4295132722 100644 --- a/.gitattributes +++ b/.gitattributes @@ -14933,7 +14933,9 @@ tests/test/toperator85.pp svneol=native#text/pascal tests/test/toperator86.pp svneol=native#text/pascal tests/test/toperator87.pp svneol=native#text/pascal tests/test/toperator88.pp svneol=native#text/pascal +tests/test/toperator89.pp svneol=native#text/pascal tests/test/toperator9.pp svneol=native#text/pascal +tests/test/toperator90.pp svneol=native#text/pascal tests/test/toperatorerror.pp svneol=native#text/plain tests/test/tover1.pp svneol=native#text/plain tests/test/tover2.pp svneol=native#text/plain @@ -17747,6 +17749,7 @@ tests/webtbs/tw3661.pp svneol=native#text/plain tests/webtbs/tw3666.pp svneol=native#text/plain tests/webtbs/tw3669.pp svneol=native#text/plain tests/webtbs/tw36698.pp -text svneol=native#text/pascal +tests/webtbs/tw36738.pp svneol=native#text/pascal tests/webtbs/tw3676.pp svneol=native#text/plain tests/webtbs/tw3681.pp svneol=native#text/plain tests/webtbs/tw3683.pp svneol=native#text/plain 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, 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 = record + SomeField: Integer; + GenField: T; + end; + + TSimpleRec = record + SomeField: Integer; + MngField: TMyManagedRec; + end; + + TMyRecSpec = specialize TGenericRec; + +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.