+ support of -Mxxx or $modeswitch to enable single mode specific features

git-svn-id: trunk@10936 -

.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

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 }

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

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);

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
 *****************************************************************************}

tests/tbf/tb0206.pp

@@ -0,0 +1,9 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch out-}
+procedure p(out o);
+  begin
+  end;
+
+begin
+end.

tests/tbf/tb0207.pp

@@ -0,0 +1,10 @@
+{ %opt=-Sew }
+{ %fail }
+{$mode objfpc}
+procedure p(out o);
+  begin
+  end;
+
+{$modeswitch out-}
+begin
+end.

tests/tbs/tb0549.pp

@@ -0,0 +1,7 @@
+{$modeswitch out+}
+procedure p(out o);
+  begin
+  end;
+
+begin
+end.

tests/tbs/tb0550.pp

@@ -0,0 +1,7 @@
+{$modeswitch out}
+procedure p(out o);
+  begin
+  end;
+
+begin
+end.

tests/tbs/tb0550a.pp

@@ -0,0 +1,7 @@
+{ %opt=-Mout+ }
+procedure p(out o);
+  begin
+  end;
+
+begin
+end.

tests/tbs/tb0550b.pp

@@ -0,0 +1,7 @@
+{ %opt=-Mout }
+procedure p(out o);
+  begin
+  end;
+
+begin
+end.