diff --git a/.gitattributes b/.gitattributes index fb0bf4ad74..222a15080c 100644 --- a/.gitattributes +++ b/.gitattributes @@ -12337,8 +12337,6 @@ tests/test/thlp6.pp svneol=native#text/pascal tests/test/thlp7.pp svneol=native#text/pascal tests/test/thlp8.pp svneol=native#text/pascal tests/test/thlp9.pp svneol=native#text/pascal -tests/test/tifthen1.pp svneol=native#text/pascal -tests/test/tifthen2.pp svneol=native#text/pascal tests/test/timplements1.pp svneol=native#text/plain tests/test/timplements2.pp svneol=native#text/plain tests/test/timplements3.pp svneol=native#text/plain diff --git a/compiler/compinnr.inc b/compiler/compinnr.inc index 5b68e9bf6a..65515d1fd8 100644 --- a/compiler/compinnr.inc +++ b/compiler/compinnr.inc @@ -89,7 +89,6 @@ const in_popcnt_x = 79; in_aligned_x = 80; in_setstring_x_y_z = 81; - in_ifthen_x_y_z = 82; { Internal constant functions } in_const_sqr = 100; diff --git a/compiler/ninl.pas b/compiler/ninl.pas index 1c6ed28151..696097924e 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -99,7 +99,6 @@ interface function handle_copy: tnode; function handle_box: tnode; function handle_unbox: tnode; - function handle_ifthen: tnode; end; tinlinenodeclass = class of tinlinenode; @@ -3282,10 +3281,6 @@ implementation set_varstate(tcallparanode(tcallparanode(tcallparanode(left).right).right).left,vs_read,[vsf_must_be_valid]); resultdef:=tcallparanode(left).left.resultdef; end; - in_ifthen_x_y_z: - begin - result:=handle_ifthen; - end; else internalerror(8); end; @@ -3636,8 +3631,6 @@ implementation in_fma_extended, in_fma_float128: result:=first_fma; - in_ifthen_x_y_z: - internalerror(2016013105); else internalerror(89); end; @@ -4252,77 +4245,6 @@ implementation end; - function tinlinenode.handle_ifthen: tnode; - var - stat : tstatementnode; - tempnode : ttempcreatenode; - n, - condexpr, - thenexpr, - elseexpr : tnode; - resdef : tdef; - begin - if left.nodetype<>callparan then - internalerror(2016013101); - condexpr:=tcallparanode(left).left; - tcallparanode(left).left:=nil; - n:=tcallparanode(left).right; - if n.nodetype<>callparan then - internalerror(2016013102); - thenexpr:=tcallparanode(n).left; - tcallparanode(n).left:=nil; - n:=tcallparanode(n).right; - if n.nodetype<>callparan then - internalerror(2016013103); - elseexpr:=tcallparanode(n).left; - tcallparanode(n).left:=nil; - if assigned(tcallparanode(n).right) then - internalerror(2016013104); - - { The result type of the expression is that of the then-expression; the - else-expression is converted to that if possible (otherwise error) - There are a few special cases however: - - constant strings need to be converted to strings - - chars need to be checked with strings - } - - if is_conststringnode(thenexpr) then - begin - if is_constwidestringnode(elseexpr) or is_constwidecharnode(elseexpr) then - resdef:=cwidestringtype - else - resdef:=cansistringtype; - end - else if is_constcharnode(thenexpr) then - begin - if is_constcharnode(elseexpr) then - resdef:=cansichartype - else if is_constwidecharnode(elseexpr) then - resdef:=cwidechartype - else if is_string(elseexpr.resultdef) then - resdef:=elseexpr.resultdef - else - resdef:=thenexpr.resultdef; - end - else - resdef:=thenexpr.resultdef; - - result:=internalstatements(stat); - - { create the tempnode that will hold our result } - tempnode:=ctempcreatenode.create(resdef,resdef.size,tt_persistent,true); - addstatement(stat,tempnode); - - n:=cifnode.create(condexpr, - cassignmentnode.create(ctemprefnode.create(tempnode),thenexpr), - cassignmentnode.create(ctemprefnode.create(tempnode),elseexpr) - ); - addstatement(stat,n); - - addstatement(stat,ctempdeletenode.create_normal_temp(tempnode)); - addstatement(stat,ctemprefnode.create(tempnode)); - end; - function tinlinenode.first_pack_unpack: tnode; var loopstatement : tstatementnode; diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index c61145c7b5..25bf41e0bc 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -914,20 +914,6 @@ implementation begin statement_syssym := inline_setstring; end; - - in_ifthen_x_y_z: - begin - consume(_LKLAMMER); - in_args:=true; - p1:=comp_expr([ef_accept_equal]); - consume(_COMMA); - p2:=comp_expr([ef_accept_equal]); - consume(_COMMA); - paras:=comp_expr([ef_accept_equal]); - statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,ccallparanode.create(paras,nil)))); - consume(_RKLAMMER); - end; - else internalerror(15); @@ -3242,6 +3228,77 @@ implementation result:=not current_procinfo.get_normal_proc.procdef.no_self_node; end; + + function factor_read_inline_if:tnode; + var + stat : tstatementnode; + tempnode : ttempcreatenode; + ifnode, + condexpr, + thenexpr, + elseexpr : tnode; + resdef : tdef; + begin + consume(_IF); + condexpr:=comp_expr([ef_accept_equal]); + consume(_THEN); + thenexpr:=comp_expr([ef_accept_equal]); + consume(_ELSE); + elseexpr:=factor(false,[ef_accept_equal]);// comp_expr([ef_accept_equal]); + + typecheckpass(condexpr); + typecheckpass(thenexpr); + typecheckpass(elseexpr); + + if (condexpr.nodetype=errorn) or + (thenexpr.nodetype=errorn) or + (elseexpr.nodetype=errorn) then + result:=cerrornode.create; + + { The result type of the expression is that of the then-expression; the + else-expression is converted to that if possible (otherwise error) + There are a few special cases however: + - constant strings need to be converted to strings + - chars need to be checked with strings + } + + if is_conststringnode(thenexpr) then + begin + if is_constwidestringnode(elseexpr) or is_constwidecharnode(elseexpr) then + resdef:=cwidestringtype + else + resdef:=cansistringtype; + end + else if is_constcharnode(thenexpr) then + begin + if is_constcharnode(elseexpr) then + resdef:=cansichartype + else if is_constwidecharnode(elseexpr) then + resdef:=cwidechartype + else if is_string(elseexpr.resultdef) then + resdef:=elseexpr.resultdef + else + resdef:=thenexpr.resultdef; + end + else + resdef:=thenexpr.resultdef; + + result:=internalstatements(stat); + + { create the tempnode that will hold our result } + tempnode:=ctempcreatenode.create(resdef,resdef.size,tt_persistent,true); + addstatement(stat,tempnode); + + ifnode:=cifnode.create(condexpr, + cassignmentnode.create(ctemprefnode.create(tempnode),thenexpr), + cassignmentnode.create(ctemprefnode.create(tempnode),elseexpr) + ); + addstatement(stat,ifnode); + + addstatement(stat,ctempdeletenode.create_normal_temp(tempnode)); + addstatement(stat,ctemprefnode.create(tempnode)); + end; + {--------------------------------------------- Factor (Main) ---------------------------------------------} @@ -3779,6 +3836,10 @@ implementation consume(_RKLAMMER); p1:=cinlinenode.create(in_objc_protocol_x,false,p1); end; + _IF: + begin + p1:=factor_read_inline_if; + end; else begin diff --git a/compiler/psystem.pas b/compiler/psystem.pas index 866ec453be..56b4c8fef7 100644 --- a/compiler/psystem.pas +++ b/compiler/psystem.pas @@ -105,7 +105,6 @@ implementation systemunit.insert(csyssym.create('ObjCEncode',in_objc_encode_x)); { objc only } systemunit.insert(csyssym.create('Default',in_default_x)); systemunit.insert(csyssym.create('SetString',in_setstring_x_y_z)); - systemunit.insert(csyssym.create('IfThen',in_ifthen_x_y_z)); systemunit.insert(cconstsym.create_ord('False',constord,0,pasbool8type)); systemunit.insert(cconstsym.create_ord('True',constord,1,pasbool8type)); end; diff --git a/tests/test/tifthen1.pp b/tests/test/tifthen1.pp deleted file mode 100644 index 04f47a38ea..0000000000 --- a/tests/test/tifthen1.pp +++ /dev/null @@ -1,27 +0,0 @@ -program tifthen1; - -procedure Test(aValue: Boolean; aErrOffset: LongInt); -var - i: LongInt; - s: String; - b: Boolean; - c: Char; -begin - i := IfThen(aValue, 42, 21); - if (aValue and (i <> 42)) or (not aValue and (i <> 21)) then - Halt(aErrOffset + 1); - b := IfThen(aValue, False, True); - if (aValue and b) or (not aValue and not b) then - Halt(aErrOffset + 2); - s := IfThen(aValue, 'Hello', 'World'); - if (aValue and (s <> 'Hello')) or (not aValue and (s <> 'World')) then - Halt(aErrOffset + 3); - c := IfThen(aValue, #13, #10); - if (aValue and (c <> #13)) or (not aValue and (c <> #10)) then - Halt(aErrOffset + 4); -end; - -begin - Test(False, 0); - Test(True, 40); -end. diff --git a/tests/test/tifthen2.pp b/tests/test/tifthen2.pp deleted file mode 100644 index db04857004..0000000000 --- a/tests/test/tifthen2.pp +++ /dev/null @@ -1,33 +0,0 @@ -program tifthen2; - -var - execA: Boolean = False; - execB: Boolean = False; - -function A: LongInt; -begin - A := 42; - execA := True; -end; - -function B: LongInt; -begin - B := 21; - execB := True; -end; - -procedure Test(aValue: Boolean; aErrOffset: LongInt); -begin - execA := False; - execB := False; - IfThen(aValue, A, B); - if (aValue and not execA) or (not aValue and not execB) then - Halt(aErrOffset + 1); - if (aValue and execB) or (not aValue and execA) then - Halt(aErrOffset + 2); -end; - -begin - Test(True, 0); - Test(False, 10); -end.