summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorsvenbarth <svenbarth@3ad0048d-3df7-0310-abae-a5850022a9f2>2020-12-13 21:52:13 +0000
committersvenbarth <svenbarth@3ad0048d-3df7-0310-abae-a5850022a9f2>2020-12-13 21:52:13 +0000
commit7326082c16e05468ec156cb0f8e824fa41c543af (patch)
tree9b964580ef167c6b369fb4e31a86eedf635a92ae
parentf47d6c2b80865013c1d457ca7060298a475fb2b5 (diff)
downloadfpc-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.pas6
-rw-r--r--compiler/systems/t_linux.pas2
-rw-r--r--rtl/inc/rtti.inc5
-rw-r--r--rtl/win/sysdl.inc2
-rw-r--r--tests/test/toperator89.pp16
-rw-r--r--tests/test/toperator90.pp16
-rw-r--r--tests/webtbs/tw36738.pp111
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.