fcl-passrc: scanner: error on misplaced $mode, bool and modeswitches for sections

git-svn-id: trunk@39429 -

packages/fcl-passrc/src/pasresolver.pp

@@ -726,6 +726,8 @@ type
     UsesScopes: TFPList; // list of TPasSectionScope
     UsesFinished: boolean;
     Finished: boolean;
+    BoolSwitches: TBoolSwitches;
+    ModeSwitches: TModeSwitches;
     constructor Create; override;
     destructor Destroy; override;
     function FindIdentifier(const Identifier: String): TPasIdentifier; override;
@@ -813,8 +815,8 @@ type
     ClassScope: TPasClassScope;
     SelfArg: TPasArgument;
     Flags: TPasProcedureScopeFlags;
-    BoolSwitches: TBoolSwitches;
-    Mode: TModeSwitch;
+    BoolSwitches: TBoolSwitches; // if Body<>nil then body start, otherwise when FinishProc
+    ModeSwitches: TModeSwitches; // at proc start
     function FindIdentifier(const Identifier: String): TPasIdentifier; override;
     procedure IterateElements(const aName: string; StartScope: TPasScope;
       const OnIterateElement: TIterateScopeElement; Data: Pointer;
@@ -1581,6 +1583,8 @@ type
     function NeedArrayValues(El: TPasElement): boolean; override;
     function GetDefaultClassVisibility(AClass: TPasClassType
       ): TPasMemberVisibility; override;
+    procedure ModeChanged(Sender: TObject; NewMode: TModeSwitch;
+      Before: boolean; var Handled: boolean); override;
     // built in types and functions
     procedure ClearBuiltInIdentifiers; virtual;
     procedure AddObjFPCBuiltInIdentifiers(
@@ -3816,7 +3820,7 @@ begin
       // there is already a previous proc
       PrevProc:=TPasProcedure(Data^.Found);
 
-      if TPasProcedureScope(Data^.LastProc.CustomData).Mode=msDelphi then
+      if msDelphi in TPasProcedureScope(Data^.LastProc.CustomData).ModeSwitches then
         begin
         if (not Data^.LastProc.IsOverload) or (not Proc.IsOverload) then
           begin
@@ -3856,7 +3860,7 @@ begin
         end;
       end;
 
-    if (ProcScope.Mode=msDelphi) and not Proc.IsOverload then
+    if (msDelphi in ProcScope.ModeSwitches) and not Proc.IsOverload then
       Abort:=true; // stop searching after this proc
 
     CandidateFound:=true;
@@ -4380,8 +4384,7 @@ begin
   CurModuleClass:=CurModule.ClassType;
   ModScope:=CurModule.CustomData as TPasModuleScope;
 
-  ModScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
-  if bsRangeChecks in ModScope.BoolSwitches then
+  if bsRangeChecks in CurrentParser.Scanner.CurrentBoolSwitches then
     begin
     Include(ModScope.Flags,pmsfRangeErrorNeeded);
     FindRangeErrorConstructors(CurModule);
@@ -8897,16 +8900,23 @@ begin
     FDefaultNameSpace:=ChompDottedIdentifier(El.Name)
   else
     FDefaultNameSpace:='';
+  ModScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
 end;
 
 procedure TPasResolver.AddSection(El: TPasSection);
 // TInterfaceSection, TImplementationSection, TProgramSection, TLibrarySection
 // Note: implementation scope is within the interface scope
+var
+  Scope: TPasSectionScope;
 begin
   if TopScope is TPasSectionScope then
     FinishSection(TPasSectionScope(TopScope).Element as TPasSection);
+  if TopScope is TPasModuleScope then
+    TPasModuleScope(TopScope).BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
   FPendingForwardProcs.Add(El); // check forward declarations at the end
-  PushScope(El,ScopeClass_Section);
+  Scope:=TPasSectionScope(PushScope(El,ScopeClass_Section));
+  Scope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
+  Scope.ModeSwitches:=CurrentParser.Scanner.CurrentModeSwitches;
 end;
 
 procedure TPasResolver.AddInitialFinalizationSection(El: TPasImplBlock);
@@ -9114,10 +9124,7 @@ begin
   if not HasDot then
     AddIdentifier(TPasIdentifierScope(TopScope),ProcName,El,pikProc);
   ProcScope:=TPasProcedureScope(PushScope(El,FScopeClass_Proc));
-  if msDelphi in CurrentParser.CurrentModeswitches then
-    ProcScope.Mode:=msDelphi
-  else
-    ProcScope.Mode:=msObjfpc;
+  ProcScope.ModeSwitches:=CurrentParser.CurrentModeswitches;
   if HasDot then
     begin
     // method implementation -> search class
@@ -13676,6 +13683,7 @@ function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
 var
   El: TPasElement;
   SrcY: integer;
+  SectionScope: TPasSectionScope;
 begin
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent),' (',ASrcPos.Row,',',ASrcPos.Column,')');
@@ -13697,7 +13705,7 @@ begin
   // create element
   El:=AClass.Create(AName,AParent);
   FLastElement:=El;
-  Result:=FLastElement;
+  Result:=El;
   El.Visibility:=AVisibility;
   El.SourceFilename:=ASrcPos.FileName;
   El.SourceLinenumber:=SrcY;
@@ -13706,6 +13714,13 @@ begin
     RootElement:=NoNil(Result) as TPasModule;
     if FStep=prsInit then
       FStep:=prsParsing;
+    end
+  else if (AParent is TPasSection) and (TPasSection(AParent).Declarations.Count=0) then
+    begin
+    // first element of section
+    SectionScope:=TPasSectionScope(AParent.CustomData);
+    SectionScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
+    SectionScope.ModeSwitches:=CurrentParser.Scanner.CurrentModeSwitches;
     end;
 
   if IsElementSkipped(El) then exit;
@@ -14552,6 +14567,17 @@ begin
     Result:=visPublic;
 end;
 
+procedure TPasResolver.ModeChanged(Sender: TObject; NewMode: TModeSwitch;
+  Before: boolean; var Handled: boolean);
+begin
+  inherited ModeChanged(Sender, NewMode, Before, Handled);
+  if not Before then
+    begin
+    if LastElement is TPasSection then
+      TPasSectionScope(LastElement.CustomData).ModeSwitches:=CurrentParser.CurrentModeswitches;
+    end;
+end;
+
 class procedure TPasResolver.UnmangleSourceLineNumber(LineNumber: integer; out
   Line, Column: integer);
 begin
@@ -17206,13 +17232,22 @@ begin
 end;
 
 function TPasResolver.GetElModeSwitches(El: TPasElement): TModeSwitches;
+var
+  C: TClass;
 begin
-  Result:=CurrentParser.CurrentModeswitches;
   while El<>nil do
     begin
-    // ToDo
+    if El.CustomData<>nil then
+      begin
+      C:=El.CustomData.ClassType;
+      if C.InheritsFrom(TPasProcedureScope) then
+        exit(TPasProcedureScope(El.CustomData).ModeSwitches)
+      else if C.InheritsFrom(TPasSectionScope) then
+        exit(TPasSectionScope(El.CustomData).ModeSwitches);
+      end;
     El:=El.Parent;
     end;
+  Result:=CurrentParser.CurrentModeswitches;
 end;
 
 function TPasResolver.GetElBoolSwitches(El: TPasElement): TBoolSwitches;
@@ -17227,6 +17262,8 @@ begin
       C:=El.CustomData.ClassType;
       if C.InheritsFrom(TPasProcedureScope) then
         exit(TPasProcedureScope(El.CustomData).BoolSwitches)
+      else if C.InheritsFrom(TPasSectionScope) then
+        exit(TPasSectionScope(El.CustomData).BoolSwitches)
       else if C.InheritsFrom(TPasModuleScope) then
         exit(TPasModuleScope(El.CustomData).BoolSwitches);
       end;

packages/fcl-passrc/src/pparser.pp

@@ -198,6 +198,8 @@ type
     function CheckPendingUsedInterface(Section: TPasSection): boolean; virtual; // true if changed
     function NeedArrayValues(El: TPasElement): boolean; virtual;
     function GetDefaultClassVisibility(AClass: TPasClassType): TPasMemberVisibility; virtual;
+    procedure ModeChanged(Sender: TObject; NewMode: TModeSwitch;
+      Before: boolean; var Handled: boolean); virtual;
     property Package: TPasPackage read FPackage;
     property InterfaceOnly : Boolean Read FInterfaceOnly Write FInterFaceOnly;
     property ScannerLogEvents : TPScannerLogEvents Read FScannerLogEvents Write FScannerLogEvents;
@@ -274,6 +276,8 @@ type
     procedure ParseClassLocalTypes(AType: TPasClassType; AVisibility: TPasMemberVisibility);
     procedure ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full: Boolean);
     procedure SetOptions(AValue: TPOptions);
+    procedure OnScannerModeChanged(Sender: TObject; NewMode: TModeSwitch;
+      Before: boolean; var Handled: boolean);
   protected
     Function SaveComments : String;
     Function SaveComments(Const AValue : String) : String;
@@ -808,6 +812,15 @@ begin
   if AClass=nil then ;  // avoid compiler warning
 end;
 
+procedure TPasTreeContainer.ModeChanged(Sender: TObject; NewMode: TModeSwitch;
+  Before: boolean; var Handled: boolean);
+begin
+  if Sender=nil then ;
+  if NewMode=msDelphi then ;
+  if Before then ;
+  if Handled then ;
+end;
+
 { ---------------------------------------------------------------------
   EParserError
   ---------------------------------------------------------------------}
@@ -874,6 +887,8 @@ constructor TPasParser.Create(AScanner: TPascalScanner;
 begin
   inherited Create;
   FScanner := AScanner;
+  if FScanner.OnModeChanged=nil then
+    FScanner.OnModeChanged:=@OnScannerModeChanged;
   FFileResolver := AFileResolver;
   FTokenRingCur:=High(FTokenRing);
   FEngine := AEngine;
@@ -891,6 +906,8 @@ destructor TPasParser.Destroy;
 var
   i: Integer;
 begin
+  if FScanner.OnModeChanged=@OnScannerModeChanged then
+    FScanner.OnModeChanged:=nil;
   if Assigned(FEngine) then
     begin
     FEngine.CurrentParser:=Nil;
@@ -3196,7 +3213,8 @@ begin
     else
       Scanner.UnSetTokenOption(toOperatorToken);
     NextToken;
-  //  writeln('TPasParser.ParseSection Token=',CurTokenString,' ',CurToken, ' ',scanner.CurFilename);
+    Scanner.SkipGlobalSwitches:=true;
+  //  writeln('TPasParser.ParseDeclarations Token=',CurTokenString,' ',CurToken, ' ',scanner.CurFilename);
     case CurToken of
       tkend:
         begin
@@ -3516,6 +3534,7 @@ var
 begin
   Result:=nil;
   UsesUnit:=nil;
+  UnitRef:=nil;
   try
     {$IFDEF VerbosePasParser}
     writeln('TPasParser.AddUseUnit AUnitName=',AUnitName,' CurModule.Name=',CurModule.Name);
@@ -3595,6 +3614,7 @@ var
   NamePos, SrcPos: TPasSourcePos;
   aModule: TPasModule;
 begin
+  Scanner.SkipGlobalSwitches:=true;
   NameExpr:=nil;
   InFileExpr:=nil;
   FreeExpr:=true;
@@ -4278,6 +4298,12 @@ begin
     FScanner.Options:=AValue;
 end;
 
+procedure TPasParser.OnScannerModeChanged(Sender: TObject;
+  NewMode: TModeSwitch; Before: boolean; var Handled: boolean);
+begin
+  Engine.ModeChanged(Self,NewMode,Before,Handled);
+end;
+
 function TPasParser.SaveComments: String;
 begin
   if Engine.NeedComments then

packages/fcl-passrc/src/pscanner.pp

@@ -55,6 +55,7 @@ const
   nWarnIllegalCompilerDirectiveX = 1028;
   nIllegalStateForWarnDirective = 1027;
   nErrIncludeLimitReached = 1028;
+  nMisplacedGlobalCompilerSwitch = 1029;
 
 // resourcestring patterns of messages
 resourcestring
@@ -88,6 +89,7 @@ resourcestring
   SWarnIllegalCompilerDirectiveX = 'Illegal compiler directive "%s"';
   SIllegalStateForWarnDirective = 'Illegal state "%s" for $WARN directive';
   SErrIncludeLimitReached = 'Include file limit reached';
+  SMisplacedGlobalCompilerSwitch = 'Misplaced global compiler switch, ignored';
 
 type
   TMessageType = (
@@ -611,6 +613,7 @@ type
     var Handled: boolean) of object;
   TPScannerFormatPathEvent = function(const aPath: string): string of object;
   TPScannerWarnEvent = procedure(Sender: TObject; Identifier: string; State: TWarnMsgState; var Handled: boolean) of object;
+  TPScannerModeDirective = procedure(Sender: TObject; NewMode: TModeSwitch; Before: boolean; var Handled: boolean) of object;
 
   TPascalScanner = class
   private
@@ -651,6 +654,7 @@ type
     FOnEvalFunction: TCEEvalFunctionEvent;
     FOnEvalVariable: TCEEvalVarEvent;
     FOnFormatPath: TPScannerFormatPathEvent;
+    FOnModeChanged: TPScannerModeDirective;
     FOnWarnDirective: TPScannerWarnEvent;
     FOptions: TPOptions;
     FLogEvents: TPScannerLogEvents;
@@ -660,6 +664,7 @@ type
     FReadOnlyModeSwitches: TModeSwitches;
     FReadOnlyValueSwitches: TValueSwitches;
     FSkipComments: Boolean;
+    FSkipGlobalSwitches: boolean;
     FSkipWhiteSpace: Boolean;
     FTokenOptions: TTokenOptions;
     FTokenStr: PChar;
@@ -742,11 +747,11 @@ type
     procedure OpenFile(AFilename: string);
     procedure FinishedModule; virtual; // called by parser after end.
     function FormatPath(const aFilename: string): string; virtual;
-    Procedure SetNonToken(aToken : TToken);
-    Procedure UnsetNonToken(aToken : TToken);
-    Procedure SetTokenOption(aOption : TTokenoption);
-    Procedure UnSetTokenOption(aOption : TTokenoption);
-    Function CheckToken(aToken : TToken; const ATokenString : String) : TToken;
+    procedure SetNonToken(aToken : TToken);
+    procedure UnsetNonToken(aToken : TToken);
+    procedure SetTokenOption(aOption : TTokenoption);
+    procedure UnSetTokenOption(aOption : TTokenoption);
+    function CheckToken(aToken : TToken; const ATokenString : String) : TToken;
     function FetchToken: TToken;
     function ReadNonPascalTillEndToken(StopAtLineEnd: boolean): TToken;
     function AddDefine(const aName: String; Quiet: boolean = false): boolean;
@@ -756,9 +761,9 @@ type
     function IfOpt(Letter: Char): boolean;
     function AddMacro(const aName, aValue: String; Quiet: boolean = false): boolean;
     function RemoveMacro(const aName: String; Quiet: boolean = false): boolean;
-    Procedure SetCompilerMode(S : String);
+    procedure SetCompilerMode(S : String);
     function CurSourcePos: TPasSourcePos;
-    Function SetForceCaret(AValue : Boolean) : Boolean; // returns old state
+    function SetForceCaret(AValue : Boolean) : Boolean; // returns old state
     function IgnoreMsgType(MsgType: TMessageType): boolean; virtual;
     property FileResolver: TBaseFileResolver read FFileResolver;
     property Files: TStrings read FFiles;
@@ -770,9 +775,9 @@ type
     property CurToken: TToken read FCurToken;
     property CurTokenString: string read FCurTokenString;
     property CurTokenPos: TPasSourcePos read FCurTokenPos;
-    Property PreviousToken : TToken Read FPreviousToken;
+    property PreviousToken : TToken Read FPreviousToken;
     property ModuleRow: Integer read FModuleRow;
-    Property NonTokens : TTokens Read FNonTokens;
+    property NonTokens : TTokens Read FNonTokens;
     Property TokenOptions : TTokenOptions Read FTokenOptions Write FTokenOptions;
     property Defines: TStrings read FDefines;
     property Macros: TStrings read FMacros;
@@ -789,8 +794,9 @@ type
     property CurrentValueSwitch[V: TValueSwitch]: string read GetCurrentValueSwitch Write SetCurrentValueSwitch;
     property WarnMsgState[Number: integer]: TWarnMsgState read GetWarnMsgState write SetWarnMsgState;
     property Options : TPOptions read FOptions write SetOptions;
-    Property SkipWhiteSpace : Boolean Read FSkipWhiteSpace Write FSkipWhiteSpace;
-    Property SkipComments : Boolean Read FSkipComments Write FSkipComments;
+    property SkipWhiteSpace : Boolean Read FSkipWhiteSpace Write FSkipWhiteSpace;
+    property SkipComments : Boolean Read FSkipComments Write FSkipComments;
+    property SkipGlobalSwitches: Boolean read FSkipGlobalSwitches write FSkipGlobalSwitches;
     property MaxIncludeStackDepth: integer read FMaxIncludeStackDepth write FMaxIncludeStackDepth default DefaultMaxIncludeStackDepth;
     property ForceCaret : Boolean read GetForceCaret;
 
@@ -801,6 +807,7 @@ type
     property OnEvalVariable: TCEEvalVarEvent read FOnEvalVariable write FOnEvalVariable;
     property OnEvalFunction: TCEEvalFunctionEvent read FOnEvalFunction write FOnEvalFunction;
     property OnWarnDirective: TPScannerWarnEvent read FOnWarnDirective write FOnWarnDirective;
+    property OnModeChanged: TPScannerModeDirective read FOnModeChanged write FOnModeChanged; // set by TPasParser
 
     property LastMsg: string read FLastMsg write FLastMsg;
     property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
@@ -1091,6 +1098,9 @@ const
     msISOLikeMod];
 
 function StrToModeSwitch(aName: String): TModeSwitch;
+function ModeSwitchesToStr(Switches: TModeSwitches): string;
+function BoolSwitchesToStr(Switches: TBoolSwitches): string;
+
 function FilenameIsAbsolute(const TheFilename: string):boolean;
 function FilenameIsWinAbsolute(const TheFilename: string): boolean;
 function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
@@ -1254,6 +1264,26 @@ begin
   Result:=msNone;
 end;
 
+function ModeSwitchesToStr(Switches: TModeSwitches): string;
+var
+  ms: TModeSwitch;
+begin
+  Result:='';
+  for ms in Switches do
+    Result:=Result+SModeSwitchNames[ms]+',';
+  Result:='['+LeftStr(Result,length(Result)-1)+']';
+end;
+
+function BoolSwitchesToStr(Switches: TBoolSwitches): string;
+var
+  bs: TBoolSwitch;
+begin
+  Result:='';
+  for bs in Switches do
+    Result:=Result+BoolSwitchNames[bs]+',';
+  Result:='['+LeftStr(Result,length(Result)-1)+']';
+end;
+
 function FilenameIsAbsolute(const TheFilename: string):boolean;
 begin
   {$IFDEF WINDOWS}
@@ -2969,22 +2999,37 @@ procedure TPascalScanner.HandleMode(const Param: String);
     const AddBoolSwitches: TBoolSwitches = [];
     const RemoveBoolSwitches: TBoolSwitches = []
     );
+  var
+    Handled: Boolean;
   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
-      FOptions:=FOptions-[po_delphi];
+    Handled:=false;
+    if Assigned(OnModeChanged) then
+      OnModeChanged(Self,LangMode,true,Handled);
+    if not Handled then
+      begin
+      CurrentModeSwitches:=(NewModeSwitches+ReadOnlyModeSwitches)*AllowedModeSwitches;
+      CurrentBoolSwitches:=CurrentBoolSwitches+(AddBoolSwitches*AllowedBoolSwitches)
+        -(RemoveBoolSwitches*AllowedBoolSwitches);
+      if IsDelphi then
+        FOptions:=FOptions+[po_delphi]
+      else
+        FOptions:=FOptions-[po_delphi];
+      end;
+    Handled:=false;
+    if Assigned(OnModeChanged) then
+      OnModeChanged(Self,LangMode,false,Handled);
   end;
 
 Var
   P : String;
-
 begin
+  if SkipGlobalSwitches then
+    begin
+    DoLog(mtWarning,nMisplacedGlobalCompilerSwitch,SMisplacedGlobalCompilerSwitch,[]);
+    exit;
+    end;
   P:=UpperCase(Param);
   Case P of
   'FPC','DEFAULT':