From 4a243d451f6c8c6595c625bc3366fad9916898d3 Mon Sep 17 00:00:00 2001 From: florian Date: Sat, 10 May 2008 22:04:53 +0000 Subject: [PATCH] + support of -Mxxx or $modeswitch to enable single mode specific features git-svn-id: trunk@10936 - --- .gitattributes | 6 +++ compiler/globtype.pas | 29 +++++++++++- compiler/options.pas | 5 +- compiler/scandir.pas | 21 +++++++++ compiler/scanner.pas | 103 ++++++++++++++++++++++++++++++------------ tests/tbf/tb0206.pp | 9 ++++ tests/tbf/tb0207.pp | 10 ++++ tests/tbs/tb0549.pp | 7 +++ tests/tbs/tb0550.pp | 7 +++ tests/tbs/tb0550a.pp | 7 +++ tests/tbs/tb0550b.pp | 7 +++ 11 files changed, 180 insertions(+), 31 deletions(-) create mode 100644 tests/tbf/tb0206.pp create mode 100644 tests/tbf/tb0207.pp create mode 100644 tests/tbs/tb0549.pp create mode 100644 tests/tbs/tb0550.pp create mode 100644 tests/tbs/tb0550a.pp create mode 100644 tests/tbs/tb0550b.pp diff --git a/.gitattributes b/.gitattributes index 397cd2d4e9..8f1b4c9fa7 100644 --- a/.gitattributes +++ b/.gitattributes @@ -6324,6 +6324,8 @@ tests/tbf/tb0203.pp svneol=native#text/plain tests/tbf/tb0204.pp svneol=native#text/plain tests/tbf/tb0204a.pp svneol=native#text/plain tests/tbf/tb0205.pp svneol=native#text/plain +tests/tbf/tb0206.pp svneol=native#text/plain +tests/tbf/tb0207.pp svneol=native#text/plain tests/tbf/ub0115.pp svneol=native#text/plain tests/tbf/ub0149.pp svneol=native#text/plain tests/tbf/ub0158a.pp svneol=native#text/plain @@ -6867,6 +6869,10 @@ tests/tbs/tb0545.pp svneol=native#text/plain tests/tbs/tb0546.pp svneol=native#text/plain tests/tbs/tb0547.pp svneol=native#text/plain tests/tbs/tb0548.pp svneol=native#text/plain +tests/tbs/tb0549.pp svneol=native#text/plain +tests/tbs/tb0550.pp svneol=native#text/plain +tests/tbs/tb0550a.pp svneol=native#text/plain +tests/tbs/tb0550b.pp svneol=native#text/plain tests/tbs/tb205.pp svneol=native#text/plain tests/tbs/ub0060.pp svneol=native#text/plain tests/tbs/ub0069.pp svneol=native#text/plain diff --git a/compiler/globtype.pas b/compiler/globtype.pas index 243f6a826d..2dbfaee665 100644 --- a/compiler/globtype.pas +++ b/compiler/globtype.pas @@ -41,7 +41,7 @@ interface {$else cpu64bitaddr} PUint = cardinal; PInt = longint; -{$endif cpu64bitaddr} +{$endif cpu64bitaddr} { Natural integer register type and size for the target machine } {$ifdef cpu64bitalu} @@ -316,6 +316,33 @@ interface pocall_default = pocall_stdcall; {$endif} + modeswitchstr : array[tmodeswitch] of string[18] = ('','', + '','','','','', + {$ifdef fpc_mode}'',{$endif} + { more specific } + 'CLASS', + 'OBJPAS', + 'RESULT', + 'PCHARTOSTRING', + 'CVAR', + 'NESTEDCOMMENTS', + 'CLASSICPROCVARS', + 'MACPROCVARS', + 'REPEATFORWARD', + 'POINTERTOPROCVAR', + 'AUTODEREF', + 'INITFINAL', + 'POINTERARITHMETICS', + 'ANSISTRINGS', + 'OUT', + 'DEFAULTPARAMETERS', + 'HINTDIRECTIVE', + 'DUPLICATELOCALS', + 'PROPERTIES', + 'ALLOWINLINE', + 'EXCEPTIONS'); + + type tprocinfoflag=( { procedure has at least one assembler block } diff --git a/compiler/options.pas b/compiler/options.pas index 892c5aed49..f2bb29cf6b 100644 --- a/compiler/options.pas +++ b/compiler/options.pas @@ -964,7 +964,8 @@ begin begin more:=Upper(more); if not SetCompileMode(more, true) then - IllegalPara(opt); + if not SetCompileModeSwitch(more, true) then + IllegalPara(opt); end; 'n' : @@ -2016,7 +2017,7 @@ begin include(init_settings.moduleswitches,cs_create_pic) else exclude(init_settings.moduleswitches,cs_create_pic); - + { Resources support } if (tf_has_winlike_resources in target_info.flags) then if def then diff --git a/compiler/scandir.pas b/compiler/scandir.pas index e62bad0f64..c76eead3ec 100644 --- a/compiler/scandir.pas +++ b/compiler/scandir.pas @@ -763,6 +763,26 @@ implementation current_module.mode_switch_allowed:= false; end; + + procedure dir_modeswitch; + var + s : string; + begin + if not current_module.in_global then + Message(scan_w_switch_is_global) + else + begin + current_scanner.skipspace; + current_scanner.readstring; + s:=pattern; + if c in ['+','-'] then + s:=s+current_scanner.readstate; + if not SetCompileModeSwitch(s,false) then + Message1(scan_w_illegal_switch,s) + end; + end; + + procedure dir_mmx; begin do_localswitch(cs_mmx); @@ -1354,6 +1374,7 @@ implementation AddDirective('MINSTACKSIZE',directive_all, @dir_minstacksize); AddDirective('MMX',directive_all, @dir_mmx); AddDirective('MODE',directive_all, @dir_mode); + AddDirective('MODESWITCH',directive_all, @dir_modeswitch); AddDirective('NODEFINE',directive_all, @dir_nodefine); AddDirective('NOTE',directive_all, @dir_note); AddDirective('NOTES',directive_all, @dir_notes); diff --git a/compiler/scanner.pas b/compiler/scanner.pas index a8bf5f0c9d..ca7d8868b1 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -201,8 +201,9 @@ interface procedure InitScanner; procedure DoneScanner; - {To be called when the language mode is finally determined} + { To be called when the language mode is finally determined } Function SetCompileMode(const s:string; changeInit: boolean):boolean; + Function SetCompileModeSwitch(s:string; changeInit: boolean):boolean; implementation @@ -256,6 +257,38 @@ implementation end; + Procedure HandleModeSwitches(changeInit: boolean); + begin + { turn ansistrings on by default ? } + if (m_default_ansistring in current_settings.modeswitches) then + begin + include(current_settings.localswitches,cs_ansistrings); + if changeinit then + include(init_settings.localswitches,cs_ansistrings); + end + else + begin + exclude(current_settings.localswitches,cs_ansistrings); + if changeinit then + exclude(init_settings.localswitches,cs_ansistrings); + end; + + { turn inline on by default ? } + if (m_default_inline in current_settings.modeswitches) then + begin + include(current_settings.localswitches,cs_do_inline); + if changeinit then + include(init_settings.localswitches,cs_do_inline); + end + else + begin + exclude(current_settings.localswitches,cs_ansistrings); + if changeinit then + exclude(init_settings.localswitches,cs_ansistrings); + end; + end; + + Function SetCompileMode(const s:string; changeInit: boolean):boolean; var b : boolean; @@ -305,33 +338,7 @@ implementation localswitcheschanged:=false; end; - { turn ansistrings on by default ? } - if (m_default_ansistring in current_settings.modeswitches) then - begin - include(current_settings.localswitches,cs_ansistrings); - if changeinit then - include(init_settings.localswitches,cs_ansistrings); - end - else - begin - exclude(current_settings.localswitches,cs_ansistrings); - if changeinit then - exclude(init_settings.localswitches,cs_ansistrings); - end; - - { turn inline on by default ? } - if (m_default_inline in current_settings.modeswitches) then - begin - include(current_settings.localswitches,cs_do_inline); - if changeinit then - include(init_settings.localswitches,cs_do_inline); - end - else - begin - exclude(current_settings.localswitches,cs_ansistrings); - if changeinit then - exclude(init_settings.localswitches,cs_ansistrings); - end; + HandleModeSwitches(changeinit); { turn on bitpacking for mode macpas } if (m_mac in current_settings.modeswitches) then @@ -407,6 +414,46 @@ implementation end; + Function SetCompileModeSwitch(s:string; changeInit: boolean):boolean; + var + i : tmodeswitch; + doinclude : boolean; + begin + s:=upper(s); + + { on/off? } + doinclude:=true; + case s[length(s)] of + '+': + s:=copy(s,1,length(s)-1); + '-': + begin + s:=copy(s,1,length(s)-1); + doinclude:=false; + end; + end; + + Result:=false; + for i:=m_class to high(tmodeswitch) do + if s=modeswitchstr[i] then + begin + if changeInit then + current_settings.modeswitches:=init_settings.modeswitches; + Result:=true; + if doinclude then + include(current_settings.modeswitches,i) + else + exclude(current_settings.modeswitches,i); + + { set other switches depending on changed mode switch } + HandleModeSwitches(changeinit); + + if changeInit then + init_settings.modeswitches:=current_settings.modeswitches; + break; + end; + end; + {***************************************************************************** Conditional Directives *****************************************************************************} diff --git a/tests/tbf/tb0206.pp b/tests/tbf/tb0206.pp new file mode 100644 index 0000000000..ec036b7b80 --- /dev/null +++ b/tests/tbf/tb0206.pp @@ -0,0 +1,9 @@ +{ %fail } +{$mode objfpc} +{$modeswitch out-} +procedure p(out o); + begin + end; + +begin +end. diff --git a/tests/tbf/tb0207.pp b/tests/tbf/tb0207.pp new file mode 100644 index 0000000000..c7d9fec56b --- /dev/null +++ b/tests/tbf/tb0207.pp @@ -0,0 +1,10 @@ +{ %opt=-Sew } +{ %fail } +{$mode objfpc} +procedure p(out o); + begin + end; + +{$modeswitch out-} +begin +end. diff --git a/tests/tbs/tb0549.pp b/tests/tbs/tb0549.pp new file mode 100644 index 0000000000..3ef8b880a0 --- /dev/null +++ b/tests/tbs/tb0549.pp @@ -0,0 +1,7 @@ +{$modeswitch out+} +procedure p(out o); + begin + end; + +begin +end. diff --git a/tests/tbs/tb0550.pp b/tests/tbs/tb0550.pp new file mode 100644 index 0000000000..c95188cde2 --- /dev/null +++ b/tests/tbs/tb0550.pp @@ -0,0 +1,7 @@ +{$modeswitch out} +procedure p(out o); + begin + end; + +begin +end. diff --git a/tests/tbs/tb0550a.pp b/tests/tbs/tb0550a.pp new file mode 100644 index 0000000000..fb4631254b --- /dev/null +++ b/tests/tbs/tb0550a.pp @@ -0,0 +1,7 @@ +{ %opt=-Mout+ } +procedure p(out o); + begin + end; + +begin +end. diff --git a/tests/tbs/tb0550b.pp b/tests/tbs/tb0550b.pp new file mode 100644 index 0000000000..2008b5ea01 --- /dev/null +++ b/tests/tbs/tb0550b.pp @@ -0,0 +1,7 @@ +{ %opt=-Mout } +procedure p(out o); + begin + end; + +begin +end.