diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index b7ce1fda75..bb888c9e1a 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -2429,7 +2429,7 @@ type end; const {Should contain the number of procedure directives we support.} - num_proc_directives=53; + num_proc_directives=54; proc_direcdata:array[1..num_proc_directives] of proc_dir_rec= ( ( @@ -2495,6 +2495,15 @@ const mutexclpocall : []; mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; mutexclpo : [po_assembler,po_external] + ),( + idtok:_DISCARDRESULT; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar]; + handler : nil; + pocall : pocall_none; + pooption : [po_discardresult]; + mutexclpocall : []; + mutexclpotype : [potype_function,potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + mutexclpo : [] ),( idtok:_DISPID; pd_flags : [pd_dispinterface]; diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 116b70883a..8d017c20d5 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -435,7 +435,9 @@ type "varargs" modifier or Mac-Pascal ".." parameter } po_variadic, { implicitly return same type as the class instance to which the message is sent } - po_objc_related_result_type + po_objc_related_result_type, + { procedure returns value (like a function), that should be discarded } + po_discardresult ); tprocoptions=set of tprocoption; @@ -1099,7 +1101,8 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has 'po_is_auto_setter',{po_is_auto_setter} 'po_noinline',{po_noinline} 'C-style array-of-const', {po_variadic} - 'objc-related-result-type' {po_objc_related_result_type} + 'objc-related-result-type', {po_objc_related_result_type} + 'po_discardresult' { po_discardresult } ); implementation diff --git a/compiler/tokens.pas b/compiler/tokens.pas index f15cd286d8..7fe203af37 100644 --- a/compiler/tokens.pas +++ b/compiler/tokens.pas @@ -305,6 +305,7 @@ type _OBJCCATEGORY, _OBJCPROTOCOL, _WEAKEXTERNAL, + _DISCARDRESULT, _DISPINTERFACE, _UNIMPLEMENTED, _IMPLEMENTATION, @@ -647,6 +648,7 @@ const (str:'OBJCCATEGORY' ;special:false;keyword:[m_objectivec1];op:NOTOKEN), { Objective-C category } (str:'OBJCPROTOCOL' ;special:false;keyword:[m_objectivec1];op:NOTOKEN), { Objective-C protocol } (str:'WEAKEXTERNAL' ;special:false;keyword:[m_none];op:NOTOKEN), + (str:'DISCARDRESULT' ;special:false;keyword:[m_none];op:NOTOKEN), (str:'DISPINTERFACE' ;special:false;keyword:[m_class];op:NOTOKEN), (str:'UNIMPLEMENTED' ;special:false;keyword:[m_none];op:NOTOKEN), (str:'IMPLEMENTATION';special:false;keyword:alllanguagemodes-[m_iso,m_extpas];op:NOTOKEN), diff --git a/compiler/wasm32/hlcgcpu.pas b/compiler/wasm32/hlcgcpu.pas index 189adffe26..eaf7ea586a 100644 --- a/compiler/wasm32/hlcgcpu.pas +++ b/compiler/wasm32/hlcgcpu.pas @@ -1876,6 +1876,8 @@ implementation begin ft:=tcpuprocdef(pd).create_functype; totalremovesize:=Length(ft.params)-Length(ft.results); + if (Length(ft.results)=0) and (po_discardresult in pd.procoptions) then + dec(totalremovesize); { remove parameters from internal evaluation stack counter (in case of e.g. no parameters and a result, it can also increase) } if totalremovesize>0 then diff --git a/compiler/wasm32/nwasmcal.pas b/compiler/wasm32/nwasmcal.pas index 5f9a7b4a93..c293363ce2 100644 --- a/compiler/wasm32/nwasmcal.pas +++ b/compiler/wasm32/nwasmcal.pas @@ -49,7 +49,7 @@ interface implementation uses - globtype, aasmdata, defutil, tgobj, hlcgcpu; + globtype, aasmdata, defutil, tgobj, hlcgcpu, symconst; { twasmcallnode } @@ -60,7 +60,7 @@ implementation procedure twasmcallnode.do_release_unused_return_value; begin - if is_void(resultdef) then + if is_void(resultdef) and not (po_discardresult in procdefinition.procoptions) then exit; current_asmdata.CurrAsmList.concat(taicpu.op_none(a_drop)); thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1); diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index e18522b616..c50438d8b1 100644 --- a/rtl/inc/systemh.inc +++ b/rtl/inc/systemh.inc @@ -1319,7 +1319,7 @@ function Pos(const substr : shortstring;c:char; Offset: Sizeint = 1): SizeInt; ****************************************************************************} {$ifdef FPC_HAS_FEATURE_ANSISTRINGS} -Procedure UniqueString(var S : RawByteString);{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}external name 'FPC_ANSISTR_UNIQUE'; +Procedure UniqueString(var S : RawByteString);{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}external name 'FPC_ANSISTR_UNIQUE';discardresult; Function Pos (const Substr : RawByteString; const Source : RawByteString; Offset: Sizeint = 1) : SizeInt; Function Pos (c : AnsiChar; const s : RawByteString; Offset: Sizeint = 1) : SizeInt; {$ifdef VER3_0} diff --git a/rtl/inc/ustringh.inc b/rtl/inc/ustringh.inc index f3ce7339a8..44673eee91 100644 --- a/rtl/inc/ustringh.inc +++ b/rtl/inc/ustringh.inc @@ -15,7 +15,7 @@ **********************************************************************} -Procedure UniqueString (Var S : UnicodeString);external name 'FPC_UNICODESTR_UNIQUE'; +Procedure UniqueString (Var S : UnicodeString);external name 'FPC_UNICODESTR_UNIQUE';discardresult; Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString; Offset: Sizeint = 1) : SizeInt; Function Pos (c : Char; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt; Function Pos (c : UnicodeChar; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt; diff --git a/rtl/inc/wstringh.inc b/rtl/inc/wstringh.inc index 9ed46b11cf..c8ef5953f8 100644 --- a/rtl/inc/wstringh.inc +++ b/rtl/inc/wstringh.inc @@ -15,7 +15,7 @@ **********************************************************************} -Procedure UniqueString (Var S : WideString);external name 'FPC_WIDESTR_UNIQUE'; +Procedure UniqueString (Var S : WideString);external name 'FPC_WIDESTR_UNIQUE';discardresult; Function Pos (Const Substr : WideString; Const Source : WideString; Offset : SizeInt = 1) : SizeInt; Function Pos (c : Char; Const s : WideString; Offset : SizeInt = 1) : SizeInt; Function Pos (c : WideChar; Const s : WideString; Offset : SizeInt = 1) : SizeInt;