diff --git a/compiler/globtype.pas b/compiler/globtype.pas index c8d2c544d0..74d58ae219 100644 --- a/compiler/globtype.pas +++ b/compiler/globtype.pas @@ -556,7 +556,8 @@ interface m_implicit_function_specialization, { attempt to specialize generic function by inferring types from parameters } m_function_references, { enable Delphi-style function references } m_anonymous_functions, { enable Delphi-style anonymous functions } - m_multiline_strings { multi-line strings denoted with '`' are enabled and valid } + m_multiline_strings, { multi-line strings denoted with '`' are enabled and valid } + m_statement_expressions { enables expressions using statements like if, case, try } ); tmodeswitches = set of tmodeswitch; @@ -764,7 +765,8 @@ interface 'IMPLICITFUNCTIONSPECIALIZATION', 'FUNCTIONREFERENCES', 'ANONYMOUSFUNCTIONS', - 'MULTILINESTRINGS' + 'MULTILINESTRINGS', + 'STATEMENTEXPRESSIONS' ); diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 5f52dbca2e..09a70544d9 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -80,7 +80,7 @@ implementation nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils, { parser } scanner, - pbase,pinline,ptype,pgenutil,psub,procinfo,cpuinfo + pbase,pstatmnt,pinline,ptype,pgenutil,psub,procinfo,cpuinfo ; function sub_expr(pred_level:Toperator_precedence;flags:texprflags;factornode:tnode):tnode;forward; @@ -4376,7 +4376,7 @@ implementation end; end - else + else if not statement_expr(p1) then begin Message(parser_e_illegal_expression); p1:=cerrornode.create; diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 56972f35f1..31f488b08f 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -48,7 +48,7 @@ const CurrentPPUVersion = 208; { for any other changes to the ppu format, increase this version number (it's a cardinal) } - CurrentPPULongVersion = 29; + CurrentPPULongVersion = 30; { unit flags } uf_big_endian = $000004; diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index 09d10fbdd0..e6bfa45313 100644 --- a/compiler/pstatmnt.pas +++ b/compiler/pstatmnt.pas @@ -30,6 +30,7 @@ interface function statement_block(starttoken : ttoken) : tnode; + function statement_expr(var p1 : tnode) : boolean; { reads an assembler block } function assembler_block : tnode; @@ -64,24 +65,65 @@ implementation function statement : tnode;forward; + function branch_type(olddef, branchdef: tdef): tdef; inline; + begin + { Handle promotion of string types to widestring and char types + to either char or widechar } + if not assigned(olddef) or + (is_anychar(olddef) and is_string(branchdef)) then + result:=branchdef + else if is_widestring(branchdef) or + ((is_ansistring(olddef) or is_chararray(olddef)) and is_widechar(branchdef)) then + result:=cwidestringtype + else if is_char(olddef) and is_widechar(branchdef) then + result:=cwidechartype + else + result:=olddef; + end; + + function if_statement(is_expr:boolean=false) : tnode; + function statementorexpr : tnode; inline; + begin + if is_expr then + result:=expr(true) + else + result:=statement; + end; - function if_statement : tnode; var ex,if_a,else_a : tnode; + statements : tstatementnode; + resultvar : ttempcreatenode; + resultdef : tdef; begin consume(_IF); ex:=comp_expr([ef_accept_equal]); consume(_THEN); if not(token in endtokens) then - if_a:=statement + if_a:=statementorexpr else if_a:=nil; + else_a:=nil; if try_to_consume(_ELSE) then - else_a:=statement - else - else_a:=nil; - result:=cifnode.create(ex,if_a,else_a); + else_a:=statementorexpr + else if is_expr then + consume(_ELSE); + if (not is_expr) then + begin + result:=cifnode.create(ex,if_a,else_a); + exit; + end; + result:=internalstatements(statements); + resultdef:=branch_type(if_a.resultdef,else_a.resultdef); + resultvar:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true); + addstatement(statements,resultvar); + addstatement(statements,cifnode.create(ex, + cassignmentnode.create(ctemprefnode.create(resultvar),if_a), + cassignmentnode.create(ctemprefnode.create(resultvar),else_a) + )); + addstatement(statements,ctempdeletenode.create_normal_temp(resultvar)); + addstatement(statements,ctemprefnode.create(resultvar)); end; { creates a block (list) of statements, til the next END token } @@ -116,7 +158,35 @@ implementation end; - function case_statement : tnode; + function case_statement(is_expr:boolean=false) : tnode; + var + resultdef : tdef; + + function statementorexpr : tnode;inline; + begin + if is_expr then + begin + result:=expr(true); + resultdef:=branch_type(resultdef,result.resultdef); + end + else + result:=statement; + end; + + function requires_else(casenode : tcasenode) : boolean; inline; + var + lv,hv : TConstExprInt; + begin + if is_boolean(casenode.left.resultdef) then + begin + lv:=0; + hv:=1; + end + else + getrange(casenode.left.resultdef,lv,hv); + Result:=casenode.labelcoverage_FINALLY) and (token<>_EXCEPT) do + if is_expr then + p_try_block:=readexpr + else begin - if first=nil then - begin - last:=cstatementnode.create(statement,nil); - first:=last; - end - else - begin - tstatementnode(last).right:=cstatementnode.create(statement,nil); - last:=tstatementnode(last).right; - end; - if not try_to_consume(_SEMICOLON) then - break; - consume_emptystats; + while (token<>_FINALLY) and (token<>_EXCEPT) do + begin + if first=nil then + begin + last:=cstatementnode.create(statement,nil); + first:=last; + end + else + begin + tstatementnode(last).right:=cstatementnode.create(statement,nil); + last:=tstatementnode(last).right; + end; + if not try_to_consume(_SEMICOLON) then + break; + consume_emptystats; + end; + p_try_block:=cblocknode.create(first); end; - p_try_block:=cblocknode.create(first); - if try_to_consume(_FINALLY) then + if token=_FINALLY then begin + if is_expr then + begin + { try-finally expressions are not allowed } + consume(_EXCEPT); + result:=cerrornode.create; + exit; + end; + consume(_FINALLY); inc(exceptblockcounter); current_exceptblock := exceptblockcounter; p_finally_block:=statements_til_end; - try_statement:=ctryfinallynode.create(p_try_block,p_finally_block); - try_statement.fileinfo:=filepostry; + result:=ctryfinallynode.create(p_try_block,p_finally_block); + result.fileinfo:=filepostry; end else begin @@ -1002,7 +1131,10 @@ implementation else consume(_ID); consume(_DO); - hp:=connode.create(nil,statement); + if is_expr then + hp:=connode.create(nil,readexpr) + else + hp:=connode.create(nil,statement); if ot.typ=errordef then begin hp.free; @@ -1040,21 +1172,45 @@ implementation if try_to_consume(_ELSE) then begin { catch the other exceptions } - p_default:=statements_til_end; + if is_expr then + p_default:=readexpr + else + p_default:=statements_til_end; end + else if is_expr then + consume(_ELSE) else consume(_END); end else begin { catch all exceptions } - p_default:=statements_til_end; + if is_expr then + p_default:=readexpr + else + p_default:=statements_til_end; end; - try_statement:=ctryexceptnode.create(p_try_block,p_specific,p_default); + result:=ctryexceptnode.create(p_try_block,p_specific,p_default); end; block_type:=old_block_type; current_exceptblock := oldcurrent_exceptblock; + + if not is_expr then + exit; + trynode:=ttryexceptnode(result); + result:=internalstatements(statements); + resultvar:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true); + addstatement(statements,resultvar); + + trynode.left:=cassignmentnode.create(ctemprefnode.create(resultvar),trynode.left); + update_onnode_assignment(resultvar,tonnode(trynode.right)); + if assigned(trynode.t1) then + trynode.t1:=cassignmentnode.create(ctemprefnode.create(resultvar),trynode.t1); + + addstatement(statements,trynode); + addstatement(statements,ctempdeletenode.create_normal_temp(resultvar)); + addstatement(statements,ctemprefnode.create(resultvar)); end; @@ -1694,4 +1850,19 @@ implementation assembler_block:=p; end; + + function statement_expr(var p1 : tnode) : boolean; + begin + if not (m_statement_expressions in current_settings.modeswitches) then + exit(false); + result:=true; + case token of + _IF: p1:=if_statement(true); + _CASE: p1:=case_statement(true); + _TRY: p1:=try_statement(true); + else + result:=false; + end; + end; + end. diff --git a/compiler/utils/ppuutils/ppudump.pp b/compiler/utils/ppuutils/ppudump.pp index 0e1fd118bc..02f947b267 100644 --- a/compiler/utils/ppuutils/ppudump.pp +++ b/compiler/utils/ppuutils/ppudump.pp @@ -2488,7 +2488,8 @@ const 'm_implicit_function_specialization', { attempt to specialize generic function by inferring types from parameters } 'm_function_references', { enable Delphi-style function references } 'm_anonymous_functions', { enable Delphi-style anonymous functions } - 'm_multiline_strings' { multi-line strings denoted with '`' are enabled and valid } + 'm_multiline_strings', { multi-line strings denoted with '`' are enabled and valid } + 'm_statement_expressions' { enables expressions using statements like if, case, try } ); { optimizer } optimizerswitchname : array[toptimizerswitch] of string[50] = diff --git a/tests/test/tstatementexpr1.pp b/tests/test/tstatementexpr1.pp new file mode 100644 index 0000000000..bca722d573 --- /dev/null +++ b/tests/test/tstatementexpr1.pp @@ -0,0 +1,11 @@ +{%FAIL} +{$ModeSwitch StatementExpressions} +var + s: String; +begin + s := case 5 of + 0: 'Foo'; + 5: 32; + else 'FooBar'; + Halt(1); +end. diff --git a/tests/test/tstatementexpr10.pp b/tests/test/tstatementexpr10.pp new file mode 100644 index 0000000000..302694bffb --- /dev/null +++ b/tests/test/tstatementexpr10.pp @@ -0,0 +1,9 @@ +{$ModeSwitch StatementExpressions} +var + s: String; +begin + s := if 0 < 1 then 'Foo' else 'Bar' + 'Baz'; + WriteLn(s); + if (s<>'Foo') then + Halt(1); +end. diff --git a/tests/test/tstatementexpr11.pp b/tests/test/tstatementexpr11.pp new file mode 100644 index 0000000000..9d1b494f87 --- /dev/null +++ b/tests/test/tstatementexpr11.pp @@ -0,0 +1,8 @@ +{$ModeSwitch StatementExpressions} +var + sz: sizeint; +begin + sz := SizeOf(if 0<1 then #65 else WideChar('A')); + WriteLn(sz); + if (sz<>SizeOf(WideChar)) then Halt(1); +end. diff --git a/tests/test/tstatementexpr12.pp b/tests/test/tstatementexpr12.pp new file mode 100644 index 0000000000..c1cc839f26 --- /dev/null +++ b/tests/test/tstatementexpr12.pp @@ -0,0 +1,8 @@ +{$ModeSwitch StatementExpressions} +var + sz: SizeInt; +begin + sz := sizeOf((if 0<1 then 'Foo' else widestring('Bar'))[1]); + WriteLn(sz); + if (sz<>2) then Halt(1); +end. diff --git a/tests/test/tstatementexpr13.pp b/tests/test/tstatementexpr13.pp new file mode 100644 index 0000000000..8107f006ef --- /dev/null +++ b/tests/test/tstatementexpr13.pp @@ -0,0 +1,25 @@ +{$Mode ObjFPC} +{$ModeSwitch StatementExpressions} + +function ConditionalThrow(doRaise: Boolean): String; +begin + Result := 'Foo'; + if doRaise then raise TObject.Create; +end; + +var + s: String; +begin + s := try ConditionalThrow(False) except 'Error'; + WriteLn(s); + if (s<>'Foo') then + Halt(1); + s := try ConditionalThrow(True) except 'Error'; + WriteLn(s); + if (s<>'Error') then + Halt(2); + s := try ConditionalThrow(True) except on o: TObject do 'TObject' else 'Error'; + WriteLn(s); + if (s<>'TObject') then + Halt(3); +end. diff --git a/tests/test/tstatementexpr14.pp b/tests/test/tstatementexpr14.pp new file mode 100644 index 0000000000..dbd18a2546 --- /dev/null +++ b/tests/test/tstatementexpr14.pp @@ -0,0 +1,10 @@ +{%FAIL} +{$Mode ObjFPC} +{$ModeSwitch StatementExpressions} + +var + s: String; +begin + s := try 'Foo' except on e: TObject do 'Error' end; + Halt(1); +end. diff --git a/tests/test/tstatementexpr2.pp b/tests/test/tstatementexpr2.pp new file mode 100644 index 0000000000..47146a8bc3 --- /dev/null +++ b/tests/test/tstatementexpr2.pp @@ -0,0 +1,16 @@ +{$ModeSwitch StatementExpressions} +type TMyEnum = (meFirst, meSecond, meLast); + +var + s: String; +begin + s := case meSecond of + meFirst: 'Foo'; + meSecond: 'Bar'; + meLast: 'FooBar'; + end; + + WriteLn(s); + if (s<>'Bar') then + Halt(1); +end. diff --git a/tests/test/tstatementexpr3.pp b/tests/test/tstatementexpr3.pp new file mode 100644 index 0000000000..4f53310310 --- /dev/null +++ b/tests/test/tstatementexpr3.pp @@ -0,0 +1,13 @@ +{$ModeSwitch StatementExpressions} +var + s: String; +begin + s := case 5 of + 0: 'Foo'; + 1..9: 'Bar'; + else 'FooBar'; + + WriteLn(s); + if (s<>'Bar') then + Halt(1); +end. diff --git a/tests/test/tstatementexpr4.pp b/tests/test/tstatementexpr4.pp new file mode 100644 index 0000000000..1aabeb0dbd --- /dev/null +++ b/tests/test/tstatementexpr4.pp @@ -0,0 +1,13 @@ +{%FAIL} +{$ModeSwitch StatementExpressions} +type TMyEnum = (meFirst, meSecond, meLast); + +var + s: String; +begin + s := case meSecond of + meFirst: 'Foo'; + meSecond: 'Bar'; + end; + Halt(1); +end. diff --git a/tests/test/tstatementexpr5.pp b/tests/test/tstatementexpr5.pp new file mode 100644 index 0000000000..66f0422a56 --- /dev/null +++ b/tests/test/tstatementexpr5.pp @@ -0,0 +1,13 @@ +{$ModeSwitch StatementExpressions} +var + sz: SizeInt; +begin + sz := sizeOf(( + case 5 of + 0: 'Foo'; + 5: widestring('Bar'); + else 'FooBar' + )[1]); + WriteLn(sz); + if (sz<>2) then Halt(1); +end. diff --git a/tests/test/tstatementexpr6.pp b/tests/test/tstatementexpr6.pp new file mode 100644 index 0000000000..6a7aa3a5fa --- /dev/null +++ b/tests/test/tstatementexpr6.pp @@ -0,0 +1,27 @@ +{$Mode ObjFPC} +{$ModeSwitch StatementExpressions} +var + counter: Integer; + +function Foo: String; +begin + Inc(Counter); + Result := 'Foo'; +end; + +function Bar: String; +begin + Inc(Counter); + Result := 'Bar'; +end; + +var + s: String; +begin + s := if 0<1 then Foo else Bar; + WriteLn(Counter, ': ', s); + if Counter<>1 then + Halt(1); + if s <> 'Foo' then + Halt(2); +end. diff --git a/tests/test/tstatementexpr7.pp b/tests/test/tstatementexpr7.pp new file mode 100644 index 0000000000..7f1e0b1701 --- /dev/null +++ b/tests/test/tstatementexpr7.pp @@ -0,0 +1,9 @@ +{$ModeSwitch StatementExpressions} +var + s: String; +begin + s := if 0 < 1 then 'Foo' else 'Bar'; + WriteLn(s); + if (s<>'Foo') then + Halt(1); +end. diff --git a/tests/test/tstatementexpr8.pp b/tests/test/tstatementexpr8.pp new file mode 100644 index 0000000000..468671a9b7 --- /dev/null +++ b/tests/test/tstatementexpr8.pp @@ -0,0 +1,8 @@ +{%FAIL} +{$ModeSwitch StatementExpressions} +var + s: String; +begin + s := if 0 < 1 then 'Foo' else 32; + Halt(1); +end. diff --git a/tests/test/tstatementexpr9.pp b/tests/test/tstatementexpr9.pp new file mode 100644 index 0000000000..891decd29e --- /dev/null +++ b/tests/test/tstatementexpr9.pp @@ -0,0 +1,11 @@ +{$ModeSwitch StatementExpressions} +var + s: String; +begin + s := if 0 < 1 then 'Foo' else + if 1 < 2 then 'Bar' else + 'Baz'; + WriteLn(s); + if (s<>'Foo') then + Halt(1); +end.