From b1b6b52842f7c45de8874941c686f76c74b6254d Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Sun, 29 Apr 2018 22:42:16 +0000 Subject: [PATCH] fcl-passrc: added bool flag $PointerMath git-svn-id: trunk@38871 - --- packages/fcl-passrc/src/pasresolver.pp | 20 ++++++------ packages/fcl-passrc/src/pscanner.pp | 37 ++++++++++++++-------- packages/fcl-passrc/tests/tcbaseparser.pas | 2 +- packages/pastojs/src/fppas2js.pp | 20 ++++++------ packages/pastojs/src/pas2jsfiler.pp | 3 +- 5 files changed, 45 insertions(+), 37 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 2826ebcca9..f8e582b9b3 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/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 - proNoPointerArithmetic // forbid pointer+integer and pointer[] + proMethodAddrAsPointer // can assign @method to a 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=[]) - or (proNoPointerArithmetic in Options) then - exit(false); // only mode fpc and objfpc allow pointer[] + if not (bsPointerMath in CurrentParser.Scanner.CurrentBoolSwitches) then + exit(false); 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 diff --git a/packages/fcl-passrc/src/pscanner.pp b/packages/fcl-passrc/src/pscanner.pp index 61b541d352..ee733d12c8 100644 --- a/packages/fcl-passrc/src/pscanner.pp +++ b/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, - bsHints,bsNotes,bsWarnings,bsMacro,bsScopedEnums]; + bsFPCMode: TBoolSwitches = [bsPointerMath]; + 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:=[]; - FAllowedBoolSwitches:=FPCModeBoolSwitches; + FCurrentBoolSwitches:=bsFPCMode; + 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; - IsDelphi: boolean); + procedure SetMode(const LangMode: TModeSwitch; + 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': diff --git a/packages/fcl-passrc/tests/tcbaseparser.pas b/packages/fcl-passrc/tests/tcbaseparser.pas index a4e29908fb..17030710cf 100644 --- a/packages/fcl-passrc/tests/tcbaseparser.pas +++ b/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; diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 0d2fc77495..f25ea5d00f 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/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 - 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, - proNoPointerArithmetic + proMethodAddrAsPointer ]; type TPas2JSResolver = class(TPasResolver) diff --git a/packages/pastojs/src/pas2jsfiler.pp b/packages/pastojs/src/pas2jsfiler.pp index d6b35d8884..09602cf13c 100644 --- a/packages/pastojs/src/pas2jsfiler.pp +++ b/packages/pastojs/src/pas2jsfiler.pp @@ -198,7 +198,8 @@ const 'Warnings', 'Macro', 'ScopedEnums', - 'ObjectChecks' + 'ObjectChecks', + 'PointerMath' ); PCUDefaultConverterOptions: TPasToJsConverterOptions = [coUseStrict];