diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index beab4ef236..6cedc9ad93 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -1801,7 +1801,9 @@ type PosEl: TPasElement; RaiseIfConst: boolean = true): boolean; function ResolvedElIsClassInstance(const ResolvedEl: TPasResolverResult): boolean; // utility functions + function ElHasModeSwitch(El: TPasElement; ms: TModeSwitch): boolean; function GetElModeSwitches(El: TPasElement): TModeSwitches; + function ElHasBoolSwitch(El: TPasElement; bs: TBoolSwitch): boolean; function GetElBoolSwitches(El: TPasElement): TBoolSwitches; function GetProcTypeDescription(ProcType: TPasProcedureType; Flags: TPRProcTypeDescFlags = [prptdUseName,prptdResolveSimpleAlias]): string; @@ -8112,7 +8114,7 @@ begin begin LTypeEl:=LeftResolved.LoTypeEl; if (LTypeEl.ClassType=TPasPointerType) - and (msAutoDeref in GetElModeSwitches(El)) + and ElHasModeSwitch(El,msAutoDeref) and (rrfReadable in LeftResolved.Flags) then begin @@ -8567,7 +8569,7 @@ procedure TPasResolver.ResolveArrayParamsArgs(Params: TParamsExpr; if not IsStringIndex then begin // pointer - if not (bsPointerMath in GetElBoolSwitches(Params)) then + if not ElHasBoolSwitch(Params,bsPointerMath) then exit(false); end; Result:=true; @@ -9624,7 +9626,7 @@ begin else if RightResolved.BaseType=btPointer then begin if (Bin.OpCode in [eopAdd,eopSubtract]) - and (bsPointerMath in GetElBoolSwitches(Bin)) then + and ElHasBoolSwitch(Bin,bsPointerMath) then begin // integer+CanonicalPointer SetResolverValueExpr(ResolvedEl,btPointer, @@ -9638,7 +9640,7 @@ begin if RightTypeEl.ClassType=TPasPointerType then begin if (Bin.OpCode in [eopAdd,eopSubtract]) - and (bsPointerMath in GetElBoolSwitches(Bin)) then + and ElHasBoolSwitch(Bin,bsPointerMath) then begin // integer+TypedPointer RightTypeEl:=TPasPointerType(RightTypeEl).DestType; @@ -9837,7 +9839,7 @@ begin if (RightResolved.BaseType in btAllInteger) then case Bin.OpCode of eopAdd,eopSubtract: - if bsPointerMath in GetElBoolSwitches(Bin) then + if ElHasBoolSwitch(Bin,bsPointerMath) then begin // pointer+integer -> pointer SetResolverValueExpr(ResolvedEl,btPointer, @@ -10118,7 +10120,7 @@ begin begin if IsDynArray(LeftTypeEl) and (Bin.OpCode=eopAdd) - and (msArrayOperators in GetElModeSwitches(Bin)) + and ElHasModeSwitch(Bin,msArrayOperators) and ((RightResolved.BaseType in [btArrayOrSet,btArrayLit]) or IsDynArray(RightResolved.LoTypeEl)) then begin @@ -10131,7 +10133,7 @@ begin else if LeftTypeEl.ClassType=TPasPointerType then begin if (RightResolved.BaseType in btAllInteger) - and (bsPointerMath in GetElBoolSwitches(Bin)) then + and ElHasBoolSwitch(Bin,bsPointerMath) then begin // TypedPointer+Integer SetLeftValueExpr([rrfReadable]); @@ -10226,7 +10228,7 @@ begin if (rrfReadable in LeftResolved.Flags) and (rrfReadable in RightResolved.Flags) and (Bin.OpCode=eopAdd) - and (msArrayOperators in GetElModeSwitches(Bin)) then + and ElHasModeSwitch(Bin,msArrayOperators) then begin if RightResolved.BaseType=btArrayLit then begin @@ -12581,14 +12583,14 @@ begin Result:=cExact else if ParamResolved.BaseType=btPointer then begin - if bsPointerMath in GetElBoolSwitches(Expr) then + if ElHasBoolSwitch(Expr,bsPointerMath) then Result:=cExact; end else if ParamResolved.BaseType=btContext then begin TypeEl:=ParamResolved.LoTypeEl; if (TypeEl.ClassType=TPasPointerType) - and (bsPointerMath in GetElBoolSwitches(Expr)) then + and ElHasBoolSwitch(Expr,bsPointerMath) then Result:=cExact; end; if Result=cIncompatible then @@ -17675,6 +17677,12 @@ begin exit(true); end; +function TPasResolver.ElHasModeSwitch(El: TPasElement; ms: TModeSwitch + ): boolean; +begin + Result:=ms in GetElModeSwitches(El); +end; + function TPasResolver.GetElModeSwitches(El: TPasElement): TModeSwitches; var C: TClass; @@ -17694,6 +17702,12 @@ begin Result:=CurrentParser.CurrentModeswitches; end; +function TPasResolver.ElHasBoolSwitch(El: TPasElement; bs: TBoolSwitch + ): boolean; +begin + Result:=bs in GetElBoolSwitches(El); +end; + function TPasResolver.GetElBoolSwitches(El: TPasElement): TBoolSwitches; var C: TClass; @@ -20280,7 +20294,7 @@ end; function TPasResolver.IsArrayOperatorAdd(Expr: TPasExpr): boolean; begin Result:=(Expr<>nil) and (Expr.ClassType=TBinaryExpr) and (Expr.OpCode=eopAdd) - and (msArrayOperators in GetElModeSwitches(Expr)); + and ElHasModeSwitch(Expr,msArrayOperators); end; function TPasResolver.IsTypeCast(Params: TParamsExpr): boolean; @@ -20603,8 +20617,14 @@ begin if El.CustomData is TResElDataBaseType then exit(true); // base type if El.Parent=nil then exit; - if (El.Parent is TPasType) and not HasTypeInfo(TPasType(El.Parent)) then - exit; + if El.Parent is TPasType then + begin + if not HasTypeInfo(TPasType(El.Parent)) then + exit; + end + else + if ElHasModeSwitch(El,msOmitRTTI) then + exit; Result:=true; end; diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index 315d38e69d..0966e5cec8 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -6329,6 +6329,8 @@ begin Result:=isVisibility(S,AVisibility); if Result then begin + if (AVisibility=visPublished) and (msOmitRTTI in Scanner.CurrentModeSwitches) then + AVisibility:=visPublic; if B then case AVisibility of visPrivate : AVisibility:=visStrictPrivate; diff --git a/packages/fcl-passrc/src/pscanner.pp b/packages/fcl-passrc/src/pscanner.pp index 67172f9b65..56454b66e8 100644 --- a/packages/fcl-passrc/src/pscanner.pp +++ b/packages/fcl-passrc/src/pscanner.pp @@ -284,7 +284,8 @@ type msArrayOperators, { use Delphi compatible array operators instead of custom ones ("+") } msExternalClass, { Allow external class definitions } msPrefixedAttributes, { Allow attributes, disable proc modifier [] } - msIgnoreAttributes { workaround til resolver/converter supports attributes } + msIgnoreAttributes, { workaround til resolver/converter supports attributes } + msOmitRTTI { treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch } ); TModeSwitches = Set of TModeSwitch; @@ -1019,7 +1020,8 @@ const 'ARRAYOPERATORS', 'EXTERNALCLASS', 'PREFIXEDATTRIBUTES', - 'IGNOREATTRIBUTES' + 'IGNOREATTRIBUTES', + 'OMITRTTI' ); LetterSwitchNames: array['A'..'Z'] of string=( diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index 2037d622dc..e0f0a8065c 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -315,6 +315,7 @@ type Procedure TestIncDec; Procedure TestIncStringFail; Procedure TestTypeInfo; + Procedure TestTypeInfo_FailRTTIDisabled; // statements Procedure TestForLoop; @@ -4707,6 +4708,21 @@ begin ParseProgram; end; +procedure TTestResolver.TestTypeInfo_FailRTTIDisabled; +begin + StartProgram(false); + Add([ + '{$modeswitch OmitRTTI}', + 'type', + ' TObject = class', + ' end;', + 'var o: TObject;', + 'begin', + ' if typeinfo(o)=nil then ;', + '']); + CheckResolverException(sSymbolCannotBePublished,nSymbolCannotBePublished); +end; + procedure TTestResolver.TestForLoop; begin StartProgram(false);