From e17f99ed84e08a27839e1f04b47aba2604483ac0 Mon Sep 17 00:00:00 2001 From: marco Date: Sun, 3 Apr 2016 11:04:10 +0000 Subject: [PATCH] --- 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 - --- .gitattributes | 4 ++++ compiler/htypechk.pas | 2 +- compiler/ncgcal.pas | 9 +++++++- compiler/pexpr.pas | 6 ++++- compiler/symdef.pas | 11 ++++++--- tests/webtbs/tw29372.pp | 49 +++++++++++++++++++++++++++++++++++++++++ tests/webtbs/tw29609.pp | 22 ++++++++++++++++++ tests/webtbs/tw29745.pp | 36 ++++++++++++++++++++++++++++++ tests/webtbs/tw29792.pp | 33 +++++++++++++++++++++++++++ 9 files changed, 166 insertions(+), 6 deletions(-) create mode 100644 tests/webtbs/tw29372.pp create mode 100644 tests/webtbs/tw29609.pp create mode 100644 tests/webtbs/tw29745.pp create mode 100644 tests/webtbs/tw29792.pp diff --git a/.gitattributes b/.gitattributes index 6ea5a320e1..8fc5b1a5dd 100644 --- a/.gitattributes +++ b/.gitattributes @@ -14342,6 +14342,7 @@ tests/webtbs/tw2920.pp svneol=native#text/plain tests/webtbs/tw2923.pp svneol=native#text/plain tests/webtbs/tw2926.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/tw2942b.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/tw2956.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/tw29745.pp svneol=native#text/pascal tests/webtbs/tw2975.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/tw2984.pp svneol=native#text/plain tests/webtbs/tw2998.pp svneol=native#text/plain diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 2672e44c65..60216d1e34 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -2377,7 +2377,7 @@ implementation while assigned(pt) do begin 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); pt:=tcallparanode(pt.right); end; diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas index 005c32ad4b..b3916dfbfc 100644 --- a/compiler/ncgcal.pas +++ b/compiler/ncgcal.pas @@ -612,7 +612,14 @@ implementation begin { don't release the funcret temp } 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); { process also all nodes of an array of const } hp:=ppn.left; diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index bdc924d90c..b40dd0b5c6 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -2722,7 +2722,11 @@ implementation { it as a class member } 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 - p1:=cloadvmtaddrnode.create(ctypenode.create(hdef)) + begin + p1:=ctypenode.create(hdef); + if not is_record(hdef) then + p1:=cloadvmtaddrnode.create(p1); + end else p1:=load_self_node; { not srsymtable.symtabletype since that can be } diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 4187fa27a0..1286c4158c 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -1158,6 +1158,7 @@ implementation function getansistringdef:tstringdef; var symtable:tsymtable; + oldstack : tsymtablestack; begin { if a codepage is explicitly defined in this mudule we need to return a replacement for ansistring def } @@ -1174,9 +1175,16 @@ implementation symtable:=current_module.globalsymtable else 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); current_module.ansistrdef:=cstringdef.createansi(current_settings.sourcecodepage); symtablestack.pop(symtable); + symtablestack.free; + symtablestack:=oldstack; end; result:=tstringdef(current_module.ansistrdef); end @@ -1963,10 +1971,7 @@ implementation begin symderef:=pderef(genericparaderefs[i]); genericparas.items[i]:=symderef^.resolve; - dispose(symderef); end; - genericparaderefs.free; - genericparaderefs:=nil; end; end; diff --git a/tests/webtbs/tw29372.pp b/tests/webtbs/tw29372.pp new file mode 100644 index 0000000000..8360aee067 --- /dev/null +++ b/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. diff --git a/tests/webtbs/tw29609.pp b/tests/webtbs/tw29609.pp new file mode 100644 index 0000000000..8f1327891d --- /dev/null +++ b/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. diff --git a/tests/webtbs/tw29745.pp b/tests/webtbs/tw29745.pp new file mode 100644 index 0000000000..069554a45f --- /dev/null +++ b/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. + diff --git a/tests/webtbs/tw29792.pp b/tests/webtbs/tw29792.pp new file mode 100644 index 0000000000..f0b4221991 --- /dev/null +++ b/tests/webtbs/tw29792.pp @@ -0,0 +1,33 @@ +unit tw29792; + +{$mode delphi} + +interface + +type + { TMyRecord } + + TMyRecord = record + class operator Add(A,B: TMyRecord): TMyRecord; + end; + +implementation + +{ TMyRecord } + +class operator TMyRecord.Add(A, B: TMyRecord): TMyRecord; +begin + // add implementation +end; + +procedure TestIfCompiles; +type + TInteger = TMyRecord; +var + N1, N2, N3: TInteger; +begin + N1 := N2 + N3; +end; + +end. +