From ab3f5744e0c92c4727703c4d0d17aa7dfef6f46f Mon Sep 17 00:00:00 2001 From: florian Date: Sat, 22 Feb 2014 09:20:57 +0000 Subject: [PATCH] * skip dec/inc type checking in unspecialized generic methods, resolves #25603 git-svn-id: trunk@26830 - --- .gitattributes | 1 + compiler/ninl.pas | 119 ++++++++++++++++++++-------------------- tests/webtbs/tw25603.pp | 28 ++++++++++ 3 files changed, 90 insertions(+), 58 deletions(-) create mode 100644 tests/webtbs/tw25603.pp diff --git a/.gitattributes b/.gitattributes index c909095e70..86387dbaed 100644 --- a/.gitattributes +++ b/.gitattributes @@ -13820,6 +13820,7 @@ tests/webtbs/tw25398.pp svneol=native#text/plain tests/webtbs/tw2540.pp svneol=native#text/plain tests/webtbs/tw25551.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/tw25685.pp svneol=native#text/pascal tests/webtbs/tw2588.pp svneol=native#text/plain diff --git a/compiler/ninl.pas b/compiler/ninl.pas index ddc4015242..68a6340919 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -2846,72 +2846,75 @@ implementation in_dec_x: begin resultdef:=voidtype; - if assigned(left) then + if not(df_generic in current_procinfo.procdef.defoptions) then begin - { first param must be var } - 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 + if assigned(left) then begin - { value of left gets changed -> must be unique } - set_unique(tcallparanode(left).left); - { two paras ? } - if assigned(tcallparanode(left).right) then - begin - if is_integer(tcallparanode(left).right.resultdef) then + { first param must be var } + 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 + { value of left gets changed -> must be unique } + set_unique(tcallparanode(left).left); + { two paras ? } + if assigned(tcallparanode(left).right) then begin - set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]); - { when range/overflow checking is on, we - convert this to a regular add, and for proper - checking we need the original type } - if ([cs_check_range,cs_check_overflow]*current_settings.localswitches=[]) then - if (tcallparanode(left).left.resultdef.typ=pointerdef) then - begin - { don't convert values added to pointers into the pointer types themselves, - because that will turn signed values into unsigned ones, which then - goes wrong when they have to be multiplied with the size of the elements - 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) + if is_integer(tcallparanode(left).right.resultdef) then + begin + set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]); + { when range/overflow checking is on, we + convert this to a regular add, and for proper + checking we need the original type } + if ([cs_check_range,cs_check_overflow]*current_settings.localswitches=[]) then + if (tcallparanode(left).left.resultdef.typ=pointerdef) then + begin + { don't convert values added to pointers into the pointer types themselves, + because that will turn signed values into unsigned ones, which then + goes wrong when they have to be multiplied with the size of the elements + 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 - 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 - inserttypeconv_internal(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resultdef); - if assigned(tcallparanode(tcallparanode(left).right).right) then - { should be handled in the parser (JM) } - internalerror(2006020901); - end - else - 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 + inserttypeconv_internal(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resultdef); + if assigned(tcallparanode(tcallparanode(left).right).right) then + { should be handled in the parser (JM) } + internalerror(2006020901); + end + else + CGMessagePos(tcallparanode(left).right.fileinfo,type_e_ordinal_expr_expected); + end; + end + { generic type parameter? } + else if is_typeparam(left.resultdef) then begin - { inc(rec) and dec(rec) assigns result value to argument } - result:=cassignmentnode.create(tcallparanode(left).left.getcopy,hp); + result:=cnothingnode.create; exit; end else - CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected); - end; - end - else - CGMessagePos(fileinfo,type_e_mismatch); + begin + hp:=self; + if isunaryoverloaded(hp) then + begin + { 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; in_read_x, diff --git a/tests/webtbs/tw25603.pp b/tests/webtbs/tw25603.pp new file mode 100644 index 0000000000..dc8dcbb62d --- /dev/null +++ b/tests/webtbs/tw25603.pp @@ -0,0 +1,28 @@ +{$MODE DELPHI} + +type + TA = class + const C = 1; + end; + + TB = class + procedure Foo; + end; + +procedure TB.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; +begin + B:=TB.Create; + B.Foo; + B.Free; + writeln('ok'); +end.