Răsfoiți Sursa

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 -

svenbarth 4 ani în urmă
părinte
comite
8a249b2d74

+ 3 - 0
.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

+ 5 - 1
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
                       (

+ 1 - 1
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);

+ 4 - 1
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;

+ 1 - 1
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

+ 16 - 0
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.

+ 16 - 0
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.

+ 111 - 0
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.