fcl-passrc: added bool flag $PointerMath

git-svn-id: trunk@38871 -

packages/fcl-passrc/src/pasresolver.pp

@@ -1088,8 +1088,7 @@ type
     //ToDo: proStaticArrayCopy, // copy works with static arrays, returning a dynamic array
     //ToDo: proStaticArrayConcat, // concat works with static arrays, returning a dynamic array
     proProcTypeWithoutIsNested, // proc types can use nested procs without 'is nested'
-    proMethodAddrAsPointer,  // can assign @method to a pointer
+    proMethodAddrAsPointer  // can assign @method to a pointer
-    proNoPointerArithmetic // forbid pointer+integer and pointer[]
     );
   TPasResolverOptions = set of TPasResolverOption;
 
@@ -8106,9 +8105,8 @@ procedure TPasResolver.ResolveArrayParamsArgs(Params: TParamsExpr;
     if not IsStringIndex then
       begin
       // pointer
-      if ([msFpc,msObjfpc]*CurrentParser.CurrentModeswitches=[])
+      if not (bsPointerMath in CurrentParser.Scanner.CurrentBoolSwitches) then
-          or (proNoPointerArithmetic in Options) then
+        exit(false);
-        exit(false); // only mode fpc and objfpc allow pointer[]
       end;
     Result:=true;
     if not (rrfReadable in ResolvedValue.Flags) then
@@ -9054,7 +9052,7 @@ begin
         else if RightResolved.BaseType=btPointer then
           begin
           if (Bin.OpCode in [eopAdd,eopSubtract])
-              and not (proNoPointerArithmetic in Options) then
+              and (bsPointerMath in CurrentParser.Scanner.CurrentBoolSwitches) then
             begin
             // integer+CanonicalPointer
             SetResolverValueExpr(ResolvedEl,btPointer,
@@ -9068,7 +9066,7 @@ begin
           if RightTypeEl.ClassType=TPasPointerType then
             begin
             if (Bin.OpCode in [eopAdd,eopSubtract])
-                and not (proNoPointerArithmetic in Options) then
+                and (bsPointerMath in CurrentParser.Scanner.CurrentBoolSwitches) then
               begin
               // integer+TypedPointer
               RightTypeEl:=TPasPointerType(RightTypeEl).DestType;
@@ -9261,7 +9259,7 @@ begin
       if (RightResolved.BaseType in btAllInteger) then
         case Bin.OpCode of
         eopAdd,eopSubtract:
-          if not (proNoPointerArithmetic in Options) then
+          if (bsPointerMath in CurrentParser.Scanner.CurrentBoolSwitches) then
             begin
             // pointer+integer -> pointer
             SetResolverValueExpr(ResolvedEl,btPointer,
@@ -9535,7 +9533,7 @@ begin
       case Bin.OpCode of
       eopAdd,eopSubtract:
         if (RightResolved.BaseType in btAllInteger)
-            and not (proNoPointerArithmetic in Options) then
+            and (bsPointerMath in CurrentParser.Scanner.CurrentBoolSwitches) then
           begin
           // TypedPointer+Integer
           SetLeftValueExpr([rrfReadable]);
@@ -11690,14 +11688,14 @@ begin
     Result:=cExact
   else if ParamResolved.BaseType=btPointer then
     begin
-    if not (proNoPointerArithmetic in Options) then
+    if (bsPointerMath in CurrentParser.Scanner.CurrentBoolSwitches) then
       Result:=cExact;
     end
   else if ParamResolved.BaseType=btContext then
     begin
     TypeEl:=ParamResolved.LoTypeEl;
     if (TypeEl.ClassType=TPasPointerType)
-        and not (proNoPointerArithmetic in Options) then
+        and (bsPointerMath in CurrentParser.Scanner.CurrentBoolSwitches) then
       Result:=cExact;
     end;
   if Result=cIncompatible then

packages/fcl-passrc/src/pscanner.pp

@@ -302,7 +302,8 @@ type
     bsWarnings,
     bsMacro,
     bsScopedEnums,
-    bsObjectChecks    // check methods 'Self' and object type casts
+    bsObjectChecks,   // check methods 'Self' and object type casts
+    bsPointerMath     // pointer arithmetic
     );
   TBoolSwitches = set of TBoolSwitch;
 const
@@ -336,8 +337,11 @@ const
     );
 
   bsAll = [low(TBoolSwitch)..high(TBoolSwitch)];
-  FPCModeBoolSwitches = [bsAlign..bsReferenceInfo,
+  bsFPCMode: TBoolSwitches = [bsPointerMath];
-                         bsHints,bsNotes,bsWarnings,bsMacro,bsScopedEnums];
+  bsObjFPCMode: TBoolSwitches = [bsPointerMath];
+  bsDelphiMode: TBoolSwitches = [];
+  bsDelphiUnicodeMode: TBoolSwitches = [];
+  bsMacPasMode: TBoolSwitches = [bsPointerMath];
 
 type
   TValueSwitch = (
@@ -996,7 +1000,8 @@ const
     'Warnings',
     'Macro',
     'ScopedEnums',
-    'ObjectChecks'
+    'ObjectChecks',
+    'PointerMath'
     );
 
   ValueSwitchNames: array[TValueSwitch] of string = (
@@ -1027,6 +1032,7 @@ const
   // mode switches of $mode FPC, don't confuse with msAllFPCModeSwitches
   FPCModeSwitches = [msFpc,msStringPchar,msNestedComment,msRepeatForward,
     msCVarSupport,msInitFinal,msHintDirective,msProperty,msDefaultInline];
+  //FPCBoolSwitches bsObjectChecks
 
   OBJFPCModeSwitches =  [msObjfpc,msClass,msObjpas,msResult,msStringPchar,msNestedComment,
     msRepeatForward,msCVarSupport,msInitFinal,msOut,msDefaultPara,msHintDirective,
@@ -2341,8 +2347,8 @@ begin
   FAllowedModes:=AllLanguageModes;
   FCurrentModeSwitches:=FPCModeSwitches;
   FAllowedModeSwitches:=msAllFPCModeSwitches;
-  FCurrentBoolSwitches:=[];
+  FCurrentBoolSwitches:=bsFPCMode;
-  FAllowedBoolSwitches:=FPCModeBoolSwitches;
+  FAllowedBoolSwitches:=bsAll;
   FAllowedValueSwitches:=vsAllValueSwitches;
   FCurrentValueSwitches[vsInterfaces]:=DefaultVSInterfaces;
 
@@ -2836,12 +2842,17 @@ end;
 
 procedure TPascalScanner.HandleMode(const Param: String);
 
-  procedure SetMode(const LangMode: TModeSwitch; const NewModeSwitches: TModeSwitches;
+  procedure SetMode(const LangMode: TModeSwitch;
-    IsDelphi: boolean);
+    const NewModeSwitches: TModeSwitches; IsDelphi: boolean;
+    const AddBoolSwitches: TBoolSwitches = [];
+    const RemoveBoolSwitches: TBoolSwitches = []
+    );
   begin
     if not (LangMode in AllowedModeSwitches) then
       Error(nErrInvalidMode,SErrInvalidMode,[Param]);
     CurrentModeSwitches:=(NewModeSwitches+ReadOnlyModeSwitches)*AllowedModeSwitches;
+    CurrentBoolSwitches:=CurrentBoolSwitches+(AddBoolSwitches*AllowedBoolSwitches)
+      -(RemoveBoolSwitches*AllowedBoolSwitches);
     if IsDelphi then
       FOptions:=FOptions+[po_delphi]
     else
@@ -2855,17 +2866,17 @@ begin
   P:=UpperCase(Param);
   Case P of
   'FPC','DEFAULT':
-    SetMode(msFpc,FPCModeSwitches,false);
+    SetMode(msFpc,FPCModeSwitches,false,bsFPCMode);
   'OBJFPC':
-    SetMode(msObjfpc,OBJFPCModeSwitches,true);
+    SetMode(msObjfpc,OBJFPCModeSwitches,true,bsObjFPCMode);
   'DELPHI':
-    SetMode(msDelphi,DelphiModeSwitches,true);
+    SetMode(msDelphi,DelphiModeSwitches,true,bsDelphiMode,[bsPointerMath]);
   'DELPHIUNICODE':
-    SetMode(msDelphiUnicode,DelphiUnicodeModeSwitches,true);
+    SetMode(msDelphiUnicode,DelphiUnicodeModeSwitches,true,bsDelphiUnicodeMode,[bsPointerMath]);
   'TP':
     SetMode(msTP7,TPModeSwitches,false);
   'MACPAS':
-    SetMode(msMac,MacModeSwitches,false);
+    SetMode(msMac,MacModeSwitches,false,bsMacPasMode);
   'ISO':
     SetMode(msIso,ISOModeSwitches,false);
   'EXTENDED':

packages/fcl-passrc/tests/tcbaseparser.pas

@@ -458,7 +458,7 @@ begin
   FResolver:=TStreamResolver.Create;
   FResolver.OwnsStreams:=True;
   FScanner:=TPascalScanner.Create(FResolver);
-  FScanner.CurrentBoolSwitches:=[bsHints,bsNotes,bsWarnings];
+  FScanner.CurrentBoolSwitches:=FScanner.CurrentBoolSwitches+[bsHints,bsNotes,bsWarnings];
   CreateEngine(FEngine);
   FParser:=TTestPasParser.Create(FScanner,FResolver,FEngine);
   FSource:=TStringList.Create;

packages/pastojs/src/fppas2js.pp

@@ -21,6 +21,7 @@ Works:
 - unit interface function
 - uses list
 - use $impl for implementation declarations, can be disabled
+- option to disable "use strict"
 - interface vars
   - only double, no other float type
   - only string, no other string type
@@ -28,7 +29,6 @@ Works:
 - implementation vars
 - external vars
 - initialization section
-- option to add "use strict";
 - procedures
   - params
   - local vars
@@ -114,6 +114,7 @@ Works:
   - bracket accessor, getter/setter has external name '[]'
   - TObject.Free sets variable to nil
   - property stored and index modifier
+  - option verify method calls -CR, bsObjectChecks
 - dynamic arrays
   - arrays can be null
   - init as "arr = []"  so typeof works
@@ -138,6 +139,7 @@ Works:
   - length(1-dim array)
   - low(1-dim array), high(1-dim array)
   - "=" operator for records with static array fields
+  - of record
 - open arrays
   - as dynamic arrays
 - enums
@@ -322,7 +324,6 @@ Works:
   - COM: with interface do
   - COM: for interface in ... do
   - COM: pass IntfVar to untyped parameter
-- option to disable use strict
 - currency:
   - as nativeint*10000
   - CurA+CurB -> CurA+CurB
@@ -338,8 +339,11 @@ Works:
   - p:=@r, p^:=r
   - p^.x, p.x
   - dispose, new
+- typecast byte(longword) -> value & $ff
 
 ToDos:
+- option typecast checking -Ct
+- writable const
 - 'new', 'Function' -> class var use .prototype
 - btArrayLit
   a: array of jsvalue;
@@ -347,14 +351,11 @@ ToDos:
 - bug:
   v:=a[0]  gives Local variable "a" is assigned but never used
 - setlength(dynarray)  modeswitch to create a copy
-- typecast byte(longword) -> value & $ff
 - static arrays
-  - a[] of record
   - clone multi dim static array
 - RTTI
   - inherit default value, inherit nodefault
   - class property
-  - type alias type
   - documentation
 - nested classes
 - asm: pas() - useful for overloads and protect an identifier from optimization
@@ -365,7 +366,7 @@ ToDos:
 Not in Version 1.0:
 - make records more lightweight
 - 1 as TEnum, ERangeError
-- ifthen
+- ifthen<T>
 - stdcall of methods: pass original 'this' as first parameter
 - move local types to unit scope
 - property read Arr[0]  https://bugs.freepascal.org/view.php?id=33416
@@ -378,10 +379,8 @@ Not in Version 1.0:
 - enums with custom values
 - library
 - constref
-- option typecast checking -Ct
-- option verify method calls -CR
-- option range checking -Cr
 - option overflow checking -Co
+  +, -, *, Succ, Pred, Inc, Dec
 - optimizations:
   - move rtl.js functions to system.pp
   - add $mod only if needed
@@ -1096,8 +1095,7 @@ const
     proExtClassInstanceNoTypeMembers,
     proOpenAsDynArrays,
     proProcTypeWithoutIsNested,
-    proMethodAddrAsPointer,
+    proMethodAddrAsPointer
-    proNoPointerArithmetic
     ];
 type
   TPas2JSResolver = class(TPasResolver)

packages/pastojs/src/pas2jsfiler.pp

@@ -198,7 +198,8 @@ const
     'Warnings',
     'Macro',
     'ScopedEnums',
-    'ObjectChecks'
+    'ObjectChecks',
+    'PointerMath'
     );
 
   PCUDefaultConverterOptions: TPasToJsConverterOptions = [coUseStrict];