paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-15 13:49:58 +01:00
Code Issues Packages Projects Releases Wiki Activity

* skip dec/inc type checking in unspecialized generic methods, resolves #25603

Browse Source 
git-svn-id: trunk@26830 -
This commit is contained in:
florian 2014-02-22 09:20:57 +00:00
parent 31ec76422a
commit ab3f5744e0
3 changed files with 90 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -13820,6 +13820,7 @@ tests/webtbs/tw25398.pp svneol=native#text/plain
tests/webtbs/tw2540.pp svneol=native#text/plain tests/webtbs/tw2540.pp svneol=native#text/plain
tests/webtbs/tw25551.pp svneol=native#text/plain tests/webtbs/tw25551.pp svneol=native#text/plain
tests/webtbs/tw25598.pp svneol=native#text/plain tests/webtbs/tw25598.pp svneol=native#text/plain
tests/webtbs/tw25603.pp svneol=native#text/pascal
tests/webtbs/tw2561.pp svneol=native#text/plain tests/webtbs/tw2561.pp svneol=native#text/plain
tests/webtbs/tw25685.pp svneol=native#text/pascal tests/webtbs/tw25685.pp svneol=native#text/pascal
tests/webtbs/tw2588.pp svneol=native#text/plain tests/webtbs/tw2588.pp svneol=native#text/plain

119
compiler/ninl.pas
View File

@ -2846,72 +2846,75 @@ implementation
in_dec_x: in_dec_x:
begin begin
resultdef:=voidtype; resultdef:=voidtype;
if assigned(left) then if not(df_generic in current_procinfo.procdef.defoptions) then
begin begin
{ first param must be var } if assigned(left) then
valid_for_var(tcallparanode(left).left,true);
set_varstate(tcallparanode(left).left,vs_readwritten,[vsf_must_be_valid]);
if (left.resultdef.typ in [enumdef,pointerdef]) or
is_ordinal(left.resultdef) or
is_currency(left.resultdef) then
begin begin
{ value of left gets changed -> must be unique } { first param must be var }
set_unique(tcallparanode(left).left); valid_for_var(tcallparanode(left).left,true);
{ two paras ? } set_varstate(tcallparanode(left).left,vs_readwritten,[vsf_must_be_valid]);
if assigned(tcallparanode(left).right) then
begin if (left.resultdef.typ in [enumdef,pointerdef]) or
if is_integer(tcallparanode(left).right.resultdef) then is_ordinal(left.resultdef) or
is_currency(left.resultdef) then
begin
{ value of left gets changed -> must be unique }
set_unique(tcallparanode(left).left);
{ two paras ? }
if assigned(tcallparanode(left).right) then
begin begin
set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]); if is_integer(tcallparanode(left).right.resultdef) then
{ when range/overflow checking is on, we begin
convert this to a regular add, and for proper set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
checking we need the original type } { when range/overflow checking is on, we
if ([cs_check_range,cs_check_overflow]*current_settings.localswitches=[]) then convert this to a regular add, and for proper
if (tcallparanode(left).left.resultdef.typ=pointerdef) then checking we need the original type }
begin if ([cs_check_range,cs_check_overflow]*current_settings.localswitches=[]) then
{ don't convert values added to pointers into the pointer types themselves, if (tcallparanode(left).left.resultdef.typ=pointerdef) then
because that will turn signed values into unsigned ones, which then begin
goes wrong when they have to be multiplied with the size of the elements { don't convert values added to pointers into the pointer types themselves,
to which the pointer points in ncginl (mantis #17342) } because that will turn signed values into unsigned ones, which then
if is_signed(tcallparanode(tcallparanode(left).right).left.resultdef) then goes wrong when they have to be multiplied with the size of the elements
inserttypeconv(tcallparanode(tcallparanode(left).right).left,ptrsinttype) to which the pointer points in ncginl (mantis #17342) }
if is_signed(tcallparanode(tcallparanode(left).right).left.resultdef) then
inserttypeconv(tcallparanode(tcallparanode(left).right).left,ptrsinttype)
else
inserttypeconv(tcallparanode(tcallparanode(left).right).left,ptruinttype)
end
else if is_integer(tcallparanode(left).left.resultdef) then
inserttypeconv(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resultdef)
else else
inserttypeconv(tcallparanode(tcallparanode(left).right).left,ptruinttype) inserttypeconv_internal(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resultdef);
end if assigned(tcallparanode(tcallparanode(left).right).right) then
else if is_integer(tcallparanode(left).left.resultdef) then { should be handled in the parser (JM) }
inserttypeconv(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resultdef) internalerror(2006020901);
else end
inserttypeconv_internal(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resultdef); else
if assigned(tcallparanode(tcallparanode(left).right).right) then CGMessagePos(tcallparanode(left).right.fileinfo,type_e_ordinal_expr_expected);
{ should be handled in the parser (JM) } end;
internalerror(2006020901); end
end { generic type parameter? }
else else if is_typeparam(left.resultdef) then
CGMessagePos(tcallparanode(left).right.fileinfo,type_e_ordinal_expr_expected);
end;
end
{ generic type parameter? }
else if is_typeparam(left.resultdef) then
begin
result:=cnothingnode.create;
exit;
end
else
begin
hp:=self;
if isunaryoverloaded(hp) then
begin begin
{ inc(rec) and dec(rec) assigns result value to argument } result:=cnothingnode.create;
result:=cassignmentnode.create(tcallparanode(left).left.getcopy,hp);
exit; exit;
end end
else else
CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected); begin
end; hp:=self;
end if isunaryoverloaded(hp) then
else begin
CGMessagePos(fileinfo,type_e_mismatch); { inc(rec) and dec(rec) assigns result value to argument }
result:=cassignmentnode.create(tcallparanode(left).left.getcopy,hp);
exit;
end
else
CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected);
end;
end
else
CGMessagePos(fileinfo,type_e_mismatch);
end;
end; end;
in_read_x, in_read_x,

28
tests/webtbs/tw25603.pp Normal file
View File

@ -0,0 +1,28 @@
{$MODE DELPHI}
type
TA = class
const C = 1;
end;
TB<T> = class
procedure Foo;
end;
procedure TB<T>.Foo;
var
i: Integer = 0;
begin
// i := i + T.C; // <- is ok
Inc(i, T.C); // Error: Incompatible types: got "untyped" expected "LongInt"
if i<>1 then
halt(1);
end;
var
B : TB<TA>;
begin
B:=TB<TA>.Create;
B.Foo;
B.Free;
writeln('ok');
end.