--- 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 -
This commit is contained in:
marco 2016-04-03 11:04:10 +00:00
parent 0bcbb4b368
commit e17f99ed84
9 changed files with 166 additions and 6 deletions

4
.gitattributes vendored
View File

@ -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

View File

@ -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;

View File

@ -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;

View File

@ -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 }

View File

@ -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;

49
tests/webtbs/tw29372.pp Normal file
View File

@ -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
tests/webtbs/tw29609.pp Normal file
View File

@ -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
tests/webtbs/tw29745.pp Normal file
View File

@ -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
tests/webtbs/tw29792.pp Normal file
View File

@ -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.