Browse Source

--- Recording mergeinfo for merge of r31987 into '.':
U .
--- Merging r32990 into '.':
A tests/webtbs/tw29372.pp
U compiler/ncgcal.pas
--- Recording mergeinfo for merge of r32990 into '.':
U .
--- Merging r33054 into '.':
U compiler/symdef.pas
--- Recording mergeinfo for merge of r33054 into '.':
G .
--- Merging r33110 into '.':
A tests/webtbs/tw29609.pp
U compiler/pexpr.pas
--- Recording mergeinfo for merge of r33110 into '.':
G .
--- Merging r33211 into '.':
U compiler/htypechk.pas
A tests/webtbs/tw29792.pp
--- Recording mergeinfo for merge of r33211 into '.':
G .
--- Merging r33214 into '.':
A tests/webtbs/tw29745.pp
G compiler/symdef.pas
--- Recording mergeinfo for merge of r33214 into '.':
G .

# revisions: 31987,32990,33054,33110,33211,33214

git-svn-id: branches/fixes_3_0@33416 -

marco 9 years ago
parent
commit
e17f99ed84

+ 4 - 0
.gitattributes

@@ -14342,6 +14342,7 @@ tests/webtbs/tw2920.pp svneol=native#text/plain
 tests/webtbs/tw2923.pp svneol=native#text/plain
 tests/webtbs/tw2923.pp svneol=native#text/plain
 tests/webtbs/tw2926.pp svneol=native#text/plain
 tests/webtbs/tw2926.pp svneol=native#text/plain
 tests/webtbs/tw2927.pp svneol=native#text/plain
 tests/webtbs/tw2927.pp svneol=native#text/plain
+tests/webtbs/tw29372.pp svneol=native#text/pascal
 tests/webtbs/tw2942a.pp svneol=native#text/plain
 tests/webtbs/tw2942a.pp svneol=native#text/plain
 tests/webtbs/tw2942b.pp svneol=native#text/plain
 tests/webtbs/tw2942b.pp svneol=native#text/plain
 tests/webtbs/tw2943.pp svneol=native#text/plain
 tests/webtbs/tw2943.pp svneol=native#text/plain
@@ -14353,9 +14354,12 @@ tests/webtbs/tw2953.pp svneol=native#text/plain
 tests/webtbs/tw29547.pp svneol=native#text/plain
 tests/webtbs/tw29547.pp svneol=native#text/plain
 tests/webtbs/tw2956.pp svneol=native#text/plain
 tests/webtbs/tw2956.pp svneol=native#text/plain
 tests/webtbs/tw2958.pp svneol=native#text/plain
 tests/webtbs/tw2958.pp svneol=native#text/plain
+tests/webtbs/tw29609.pp svneol=native#text/pascal
 tests/webtbs/tw2966.pp svneol=native#text/plain
 tests/webtbs/tw2966.pp svneol=native#text/plain
+tests/webtbs/tw29745.pp svneol=native#text/pascal
 tests/webtbs/tw2975.pp svneol=native#text/plain
 tests/webtbs/tw2975.pp svneol=native#text/plain
 tests/webtbs/tw2976.pp svneol=native#text/plain
 tests/webtbs/tw2976.pp svneol=native#text/plain
+tests/webtbs/tw29792.pp svneol=native#text/pascal
 tests/webtbs/tw2983.pp svneol=native#text/plain
 tests/webtbs/tw2983.pp svneol=native#text/plain
 tests/webtbs/tw2984.pp svneol=native#text/plain
 tests/webtbs/tw2984.pp svneol=native#text/plain
 tests/webtbs/tw2998.pp svneol=native#text/plain
 tests/webtbs/tw2998.pp svneol=native#text/plain

+ 1 - 1
compiler/htypechk.pas

@@ -2377,7 +2377,7 @@ implementation
             while assigned(pt) do
             while assigned(pt) do
               begin
               begin
                 if (pt.resultdef.typ=recorddef) and
                 if (pt.resultdef.typ=recorddef) and
-                    (sto_has_operator in tabstractrecorddef(pt.resultdef).owner.tableoptions) then
+                    (sto_has_operator in tabstractrecorddef(pt.resultdef).symtable.tableoptions) then
                   collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList,searchhelpers,anoninherited);
                   collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList,searchhelpers,anoninherited);
                 pt:=tcallparanode(pt.right);
                 pt:=tcallparanode(pt.right);
               end;
               end;

+ 8 - 1
compiler/ncgcal.pas

@@ -612,7 +612,14 @@ implementation
                begin
                begin
                  { don't release the funcret temp }
                  { don't release the funcret temp }
                  if not(assigned(ppn.parasym)) or
                  if not(assigned(ppn.parasym)) or
-                    not(vo_is_funcret in ppn.parasym.varoptions) then
+                    not(
+                      (vo_is_funcret in ppn.parasym.varoptions) or
+                      (
+                        (vo_is_self in ppn.parasym.varoptions) and
+                        (procdefinition.proctypeoption=potype_constructor) and
+                        (ppn.parasym.vardef.typ<>objectdef)
+                      )
+                    )then
                    location_freetemp(current_asmdata.CurrAsmList,ppn.left.location);
                    location_freetemp(current_asmdata.CurrAsmList,ppn.left.location);
                  { process also all nodes of an array of const }
                  { process also all nodes of an array of const }
                  hp:=ppn.left;
                  hp:=ppn.left;

+ 5 - 1
compiler/pexpr.pas

@@ -2722,7 +2722,11 @@ implementation
                           { it as a class member                                }
                           { it as a class member                                }
                           if (assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef)) or
                           if (assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef)) or
                              (assigned(current_procinfo) and current_procinfo.get_normal_proc.procdef.no_self_node) then
                              (assigned(current_procinfo) and current_procinfo.get_normal_proc.procdef.no_self_node) then
-                            p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
+                            begin
+                              p1:=ctypenode.create(hdef);
+                              if not is_record(hdef) then
+                                p1:=cloadvmtaddrnode.create(p1);
+                            end
                           else
                           else
                             p1:=load_self_node;
                             p1:=load_self_node;
                         { not srsymtable.symtabletype since that can be }
                         { not srsymtable.symtabletype since that can be }

+ 8 - 3
compiler/symdef.pas

@@ -1158,6 +1158,7 @@ implementation
     function getansistringdef:tstringdef;
     function getansistringdef:tstringdef;
       var
       var
         symtable:tsymtable;
         symtable:tsymtable;
+        oldstack : tsymtablestack;
       begin
       begin
         { if a codepage is explicitly defined in this mudule we need to return
         { if a codepage is explicitly defined in this mudule we need to return
           a replacement for ansistring def }
           a replacement for ansistring def }
@@ -1174,9 +1175,16 @@ implementation
                   symtable:=current_module.globalsymtable
                   symtable:=current_module.globalsymtable
                 else
                 else
                   symtable:=current_module.localsymtable;
                   symtable:=current_module.localsymtable;
+                { create a temporary stack as it's not good (TM) to mess around
+                  with the order if the unit contains generics or helpers; don't
+                  use a def aware symtablestack though }
+                oldstack:=symtablestack;
+                symtablestack:=tsymtablestack.create;
                 symtablestack.push(symtable);
                 symtablestack.push(symtable);
                 current_module.ansistrdef:=cstringdef.createansi(current_settings.sourcecodepage);
                 current_module.ansistrdef:=cstringdef.createansi(current_settings.sourcecodepage);
                 symtablestack.pop(symtable);
                 symtablestack.pop(symtable);
+                symtablestack.free;
+                symtablestack:=oldstack;
               end;
               end;
             result:=tstringdef(current_module.ansistrdef);
             result:=tstringdef(current_module.ansistrdef);
           end
           end
@@ -1963,10 +1971,7 @@ implementation
               begin
               begin
                 symderef:=pderef(genericparaderefs[i]);
                 symderef:=pderef(genericparaderefs[i]);
                 genericparas.items[i]:=symderef^.resolve;
                 genericparas.items[i]:=symderef^.resolve;
-                dispose(symderef);
               end;
               end;
-            genericparaderefs.free;
-            genericparaderefs:=nil;
           end;
           end;
       end;
       end;
 
 

+ 49 - 0
tests/webtbs/tw29372.pp

@@ -0,0 +1,49 @@
+program tw29372;
+
+{$MODE DELPHI}
+type
+  TR1 = record
+    A, B, C: Int64;
+    constructor Create(_A, _B, _C: Int64);
+  end;
+
+  TR2 = record
+    D, E, F: Int64;
+    constructor Create(_D, _E, _F: Int64);
+  end;
+
+  constructor TR1.Create(_A, _B, _C: Int64);
+  begin
+    A := _A;
+    B := _B;
+    C := _C;
+  end;
+
+  constructor TR2.Create(_D, _E, _F: Int64);
+  begin
+    D := _D;
+    E := _E;
+    F := _F;
+  end;
+
+{ Note: unlike in the file attached at #29372 we use "const" both times to
+        trigger the error on x86_64 as well }
+procedure Foo(const _1: TR1; const _2: TR2);
+begin
+  if _1.A <> 1 then
+    Halt(1);
+  if _1.B <> 2 then
+    Halt(2);
+  if _1.C <> 3 then
+    Halt(3);
+  if _2.D <> 4 then
+    Halt(2);
+  if _2.E <> 5 then
+    Halt(5);
+  if _2.F <> 6 then
+    Halt(6);
+end;
+
+begin
+  Foo(TR1.Create(1, 2, 3), TR2.Create(4,5,6));
+end.

+ 22 - 0
tests/webtbs/tw29609.pp

@@ -0,0 +1,22 @@
+{ %NORUN }
+
+{$mode objfpc}
+{$MODESWITCH AdvancedRecords}
+program tw29609;
+
+
+type t = record
+        class var      v : Boolean;
+        class function f : Boolean;  static;
+        class property p : Boolean  read v;
+        end;
+
+
+class function t.f : Boolean;
+begin
+Result := p;    // "Error: Pointer to object expected"
+end;
+
+
+begin
+end.

+ 36 - 0
tests/webtbs/tw29745.pp

@@ -0,0 +1,36 @@
+{ %NORUN }
+
+program tw29745;
+
+{$apptype console}
+{$ifdef fpc}
+{$mode objfpc}
+{$h+}
+{$codepage utf8}
+{$endif}
+
+uses Classes;
+
+type
+  TFoo = class helper for TStream
+  public
+    procedure Bar;
+  end;
+
+  procedure TFoo.Bar;
+  begin
+  end;
+
+var
+  s: string = '';
+  m: TStream;
+begin
+  m := TMemoryStream.Create;
+  try
+    m.Bar;
+  finally
+    m.Free;
+  end;
+  writeln(defaultsystemcodepage);
+end.
+

+ 33 - 0
tests/webtbs/tw29792.pp

@@ -0,0 +1,33 @@
+unit tw29792;
+
+{$mode delphi}
+
+interface
+
+type
+  { TMyRecord }
+
+  TMyRecord<T> = record
+    class operator Add(A,B: TMyRecord<T>): TMyRecord<T>;
+  end;
+
+implementation
+
+{ TMyRecord }
+
+class operator TMyRecord<T>.Add(A, B: TMyRecord<T>): TMyRecord<T>;
+begin
+  // add implementation
+end;
+
+procedure TestIfCompiles;
+type
+  TInteger = TMyRecord<Integer>;
+var
+  N1, N2, N3: TInteger;
+begin
+  N1 := N2 + N3;
+end;
+
+end.
+