compiler: replace MODESWTICH POINTERARITHMETICS with $POINTERMATH directive, disable pointer arithmetic in delphi mode by default (compatible with delphi), enable pointer arithmetic in fpc/objfpc modes as they had it enabled by default before, add has_pointer_math field to tpointerdef to allow pointer arithmetic with such pointer even if pointer math mode is off (delphi compatible) + tests

git-svn-id: trunk@16651 -

.gitattributes

@@ -9641,6 +9641,9 @@ tests/test/tparray7.pp svneol=native#text/plain
 tests/test/tparray8.pp svneol=native#text/plain
 tests/test/tparray9.pp svneol=native#text/plain
 tests/test/tpftch1.pp svneol=native#text/plain
+tests/test/tpointermath1.pp svneol=native#text/pascal
+tests/test/tpointermath2.pp svneol=native#text/pascal
+tests/test/tpointermath3.pp svneol=native#text/pascal
 tests/test/tpoll.pp svneol=native#text/plain
 tests/test/tprec1.pp svneol=native#text/plain
 tests/test/tprec10.pp svneol=native#text/plain

compiler/globals.pas

@@ -51,15 +51,15 @@ interface
        delphimodeswitches =
          [m_delphi,m_all,m_class,m_objpas,m_result,m_string_pchar,
           m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal,m_default_ansistring,
-          m_out,m_default_para,m_duplicate_names,m_hintdirective,m_add_pointer,
+          m_out,m_default_para,m_duplicate_names,m_hintdirective,
           m_property,m_default_inline,m_except,m_extended_records];
        fpcmodeswitches =
          [m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward,
-          m_cvar_support,m_initfinal,m_add_pointer,m_hintdirective,
+          m_cvar_support,m_initfinal,m_hintdirective,
           m_property,m_default_inline];
        objfpcmodeswitches =
          [m_objfpc,m_fpc,m_all,m_class,m_objpas,m_result,m_string_pchar,m_nested_comment,
-          m_repeat_forward,m_cvar_support,m_initfinal,m_add_pointer,m_out,m_default_para,m_hintdirective,
+          m_repeat_forward,m_cvar_support,m_initfinal,m_out,m_default_para,m_hintdirective,
           m_property,m_default_inline,m_except];
        tpmodeswitches =
          [m_tp7,m_all,m_tp_procvar,m_duplicate_names];
@@ -350,7 +350,7 @@ interface
         );
         globalswitches : [cs_check_unit_name,cs_link_static];
         moduleswitches : [cs_extsyntax,cs_implicit_exceptions];
-        localswitches : [cs_check_io,cs_typed_const_writable];
+        localswitches : [cs_check_io,cs_typed_const_writable,cs_pointermath];
         modeswitches : fpcmodeswitches;
         optimizerswitches : [];
         genwpoptimizerswitches : [];

compiler/globtype.pas

@@ -110,7 +110,7 @@ interface
          cs_mmx,cs_mmx_saturation,
          { parser }
          cs_typed_addresses,cs_strict_var_strings,cs_ansistrings,cs_bitpacking,
-         cs_varpropsetter,cs_scopedenums,
+         cs_varpropsetter,cs_scopedenums,cs_pointermath,
          { macpas specific}
          cs_external_var, cs_externally_visible
        );
@@ -261,7 +261,6 @@ interface
                                   procedure variables                     }
          m_autoderef,           { does auto dereferencing of struct. vars }
          m_initfinal,           { initialization/finalization for units }
-         m_add_pointer,         { allow pointer add/sub operations }
          m_default_ansistring,  { ansistring turned on by default }
          m_out,                 { support the calling convention OUT }
          m_default_para,        { support default parameters }
@@ -382,7 +381,6 @@ interface
          'POINTERTOPROCVAR',
          'AUTODEREF',
          'INITFINAL',
-         'POINTERARITHMETICS',
          'ANSISTRINGS',
          'OUT',
          'DEFAULTPARAMETERS',

compiler/nadd.pas

@@ -1737,7 +1737,7 @@ implementation
             if nodetype=addn then
               begin
                 if not(cs_extsyntax in current_settings.moduleswitches) or
-                   (not(is_pchar(ld)) and not(m_add_pointer in current_settings.modeswitches)) then
+                   (not(is_pchar(ld)) and not(cs_pointermath in current_settings.localswitches) and not tpointerdef(ld).has_pointer_math) then
                   CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
                 if (rd.typ=pointerdef) and
                    (tpointerdef(rd).pointeddef.size>1) then
@@ -1768,7 +1768,7 @@ implementation
                  if (lt=niln) then
                    CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),'NIL',rd.typename);
                  if not(cs_extsyntax in current_settings.moduleswitches) or
-                    (not(is_pchar(ld)) and not(m_add_pointer in current_settings.modeswitches)) then
+                    (not(is_pchar(ld)) and not(cs_pointermath in current_settings.localswitches) and not tpointerdef(ld).has_pointer_math) then
                    CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
                  if (ld.typ=pointerdef) then
                  begin

compiler/nmem.pas

@@ -863,7 +863,8 @@ implementation
                  (except voidpointer) in delphi/tp7 it's only allowed for pchars. }
                if not is_voidpointer(left.resultdef) and
                   (
-                   (m_fpc in current_settings.modeswitches) or
+                   (cs_pointermath in current_settings.localswitches) or
+                   tpointerdef(left.resultdef).has_pointer_math or
                    is_pchar(left.resultdef) or
                    is_pwidechar(left.resultdef)
                   ) then

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 124;
+  CurrentPPUVersion = 125;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/scandir.pas

@@ -946,6 +946,11 @@ unit scandir;
       recordpendingverbosityfullswitch(switchesstatestack[switchesstatestackpos].verbosity);
     end;
 
+    procedure dir_pointermath;
+      begin
+        do_localswitch(cs_pointermath);
+      end;
+
     procedure dir_profile;
       begin
         do_moduleswitch(cs_profile);
@@ -1450,6 +1455,7 @@ unit scandir;
         AddDirective('PACKSET',directive_all, @dir_packset);
         AddDirective('PASCALMAINNAME',directive_all, @dir_pascalmainname);
         AddDirective('PIC',directive_all, @dir_pic);
+        AddDirective('POINTERMATH',directive_all, @dir_pointermath);
         AddDirective('POP',directive_all, @dir_pop);
         AddDirective('PROFILE',directive_all, @dir_profile);
         AddDirective('PUSH',directive_all, @dir_push);

compiler/scanner.pas

@@ -378,6 +378,20 @@ implementation
                  include(init_settings.moduleswitches,cs_support_goto);
              end;
 
+           { support pointer math by default in fpc/objfpc modes }
+           if ([m_fpc,m_objfpc] * current_settings.modeswitches <> []) then
+             begin
+               include(current_settings.localswitches,cs_pointermath);
+               if changeinit then
+                 include(init_settings.localswitches,cs_pointermath);
+             end
+           else
+             begin
+               exclude(current_settings.localswitches,cs_pointermath);
+               if changeinit then
+                 exclude(init_settings.localswitches,cs_pointermath);
+             end;
+
            { Default enum and set packing for delphi/tp7 }
            if (m_tp7 in current_settings.modeswitches) or
               (m_delphi in current_settings.modeswitches) then

compiler/symdef.pas

@@ -161,6 +161,7 @@ interface
 
        tpointerdef = class(tabstractpointerdef)
           is_far : boolean;
+          has_pointer_math : boolean;
           constructor create(def:tdef);
           constructor createfar(def:tdef);
           function getcopy:tstoreddef;override;
@@ -2085,6 +2086,7 @@ implementation
       begin
         inherited create(pointerdef,def);
         is_far:=false;
+        has_pointer_math:=cs_pointermath in current_settings.localswitches;
       end;
 
 
@@ -2092,6 +2094,7 @@ implementation
       begin
         inherited create(pointerdef,def);
         is_far:=true;
+        has_pointer_math:=cs_pointermath in current_settings.localswitches;
       end;
 
 
@@ -2099,6 +2102,7 @@ implementation
       begin
          inherited ppuload(pointerdef,ppufile);
          is_far:=(ppufile.getbyte<>0);
+         has_pointer_math:=(ppufile.getbyte<>0);
       end;
 
 
@@ -2112,6 +2116,7 @@ implementation
         else
           result:=tpointerdef.create(pointeddef);
         tpointerdef(result).is_far:=is_far;
+        tpointerdef(result).has_pointer_math:=has_pointer_math;
         tpointerdef(result).savesize:=savesize;
       end;
 
@@ -2120,6 +2125,7 @@ implementation
       begin
          inherited ppuwrite(ppufile);
          ppufile.putbyte(byte(is_far));
+         ppufile.putbyte(byte(has_pointer_math));
          ppufile.writeentry(ibpointerdef);
       end;
 

compiler/utils/ppudump.pp

@@ -1933,6 +1933,7 @@ begin
              write  (space,'     Pointed Type : ');
              readderef('');
              writeln(space,'           Is Far : ',(getbyte<>0));
+             writeln(space,' Has Pointer Math : ',(getbyte<>0));
            end;
 
          iborddef :

tests/test/tpointermath1.pp

@@ -0,0 +1,24 @@
+{ %norun }
+program tpointermath1;
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+type
+  {$POINTERMATH ON}
+  PByte = ^Byte; // Pointer arithmetic can be applied to types declared with PointerMath ON
+  {$POINTERMATH OFF}
+  PInteger = ^Integer;
+var
+  PB: PByte;
+  PI: PInteger;
+begin
+  // This checks even with PointerMath=Off it still can be used for types declared with PointerMath=On
+  PB := PB + 1;
+  WriteLn(PB[1]);
+  {$POINTERMATH ON}
+  // It can also be used if explicitely declared in the code
+  PI := PI + 1;
+  WriteLn(PI[1]);
+end.
+

tests/test/tpointermath2.pp

@@ -0,0 +1,15 @@
+{ %fail }
+program tpointermath2;
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+type
+  PByte = ^Byte;
+var
+  PB: PByte;
+begin
+  // Pointer math must fail in delphi mode without pointermath directive
+  PB := PB + 1;
+end.
+

tests/test/tpointermath3.pp

@@ -0,0 +1,14 @@
+{ %norun }
+program tpointermath3;
+
+{$MODE FPC}
+type
+  PByte = ^Byte;
+var
+  PB: PByte;
+begin
+  // in FPC/ObjFPC mode pointer math is ON by default
+  PB := PB + 1;
+  WriteLn(PB[1]);
+end.
+