mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 05:08:06 +02:00
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: branches/fixes_3_2@47771 -
This commit is contained in:
parent
c9c1c1686c
commit
8a249b2d74
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -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
|
||||
|
@ -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
|
||||
(
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
16
tests/test/toperator89.pp
Normal file
16
tests/test/toperator89.pp
Normal file
@ -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.
|
16
tests/test/toperator90.pp
Normal file
16
tests/test/toperator90.pp
Normal file
@ -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.
|
111
tests/webtbs/tw36738.pp
Normal file
111
tests/webtbs/tw36738.pp
Normal file
@ -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.
|
Loading…
Reference in New Issue
Block a user