Browse Source

fcl-passrc: scanner: added boolswitches, resolver: $ScopedEnums

git-svn-id: trunk@37815 -
Mattias Gaertner 7 years ago
parent
commit
9197cc2b47

+ 23 - 20
packages/fcl-passrc/src/pasresolver.pp

@@ -6823,29 +6823,32 @@ begin
     RaiseInvalidScopeForElement(20160929205736,El);
   AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
 
-  // propagate enum to parent scopes
-  for i:=ScopeCount-2 downto 0 do
+  if not (bsScopedEnums in CurrentParser.Scanner.CurrentBoolSwitches) then
     begin
-    Scope:=Scopes[i];
-    if (Scope is TPasClassScope) or (Scope is TPasRecordScope) then
+    // propagate enum to parent scopes
+    for i:=ScopeCount-2 downto 0 do
       begin
-      // class or record: add if not duplicate
-      Old:=TPasIdentifierScope(Scope).FindIdentifier(El.Name);
-      if Old=nil then
+      Scope:=Scopes[i];
+      if (Scope is TPasClassScope) or (Scope is TPasRecordScope) then
+        begin
+        // class or record: add if not duplicate
+        Old:=TPasIdentifierScope(Scope).FindIdentifier(El.Name);
+        if Old=nil then
+          TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
+        end
+      else if (Scope is TPasProcedureScope) or (Scope is TPasSectionScope) then
+        begin
+        // procedure or section: check for duplicate and add
+        Old:=TPasIdentifierScope(Scope).FindLocalIdentifier(El.Name);
+        if Old<>nil then
+          RaiseMsg(20170216152224,nDuplicateIdentifier,sDuplicateIdentifier,
+                   [El.Name,GetElementSourcePosStr(Old.Element)],El);
         TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
-      end
-    else if (Scope is TPasProcedureScope) or (Scope is TPasSectionScope) then
-      begin
-      // procedure or section: check for duplicate and add
-      Old:=TPasIdentifierScope(Scope).FindLocalIdentifier(El.Name);
-      if Old<>nil then
-        RaiseMsg(20170216152224,nDuplicateIdentifier,sDuplicateIdentifier,
-                 [El.Name,GetElementSourcePosStr(Old.Element)],El);
-      TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
-      break;
-      end
-    else
-      break;
+        break;
+        end
+      else
+        break;
+      end;
     end;
 end;
 

+ 106 - 23
packages/fcl-passrc/src/pscanner.pp

@@ -269,6 +269,16 @@ type
   );
   TModeSwitches = Set of TModeSwitch;
 
+  // switches, that can be 'on' or 'off' and have no corresponding letter switch
+  TBoolSwitch = (
+    bsMacro,
+    bsScopedEnums
+    );
+  TBoolSwitches = set of TBoolSwitch;
+const
+  bsAll = [bsMacro..bsScopedEnums];
+
+type
   TTokenOption = (toForceCaret,toOperatorToken);
   TTokenOptions = Set of TTokenOption;
 
@@ -511,9 +521,11 @@ type
 
   TPascalScanner = class
   private
+    FAllowedBoolSwitches: TBoolSwitches;
     FAllowedModes: TModeSwitches;
     FAllowedModeSwitches: TModeSwitches;
     FConditionEval: TCondDirectiveEvaluator;
+    FCurrentBoolSwitches: TBoolSwitches;
     FCurrentModeSwitches: TModeSwitches;
     FCurTokenPos: TPasSourcePos;
     FLastMsg: string;
@@ -530,7 +542,6 @@ type
     FCurLine: string;
     FMacros,
     FDefines: TStrings;
-    FMacrosOn: boolean;
     FNonTokens: TTokens;
     FOnDirective: TPScannerDirectiveEvent;
     FOnEvalFunction: TCEEvalFunctionEvent;
@@ -540,6 +551,7 @@ type
     FLogEvents: TPScannerLogEvents;
     FOnLog: TPScannerLogHandler;
     FPreviousToken: TToken;
+    FReadOnlyBoolSwitches: TBoolSwitches;
     FReadOnlyModeSwitches: TModeSwitches;
     FSkipComments: Boolean;
     FSkipWhiteSpace: Boolean;
@@ -555,15 +567,20 @@ type
     PPIsSkippingStack: array[0..255] of Boolean;
     function GetCurColumn: Integer;
     function GetForceCaret: Boolean;
+    function GetMacrosOn: boolean;
     function OnCondEvalFunction(Sender: TCondDirectiveEvaluator; Name,
       Param: String; out Value: string): boolean;
     procedure OnCondEvalLog(Sender: TCondDirectiveEvaluator;
       Args: array of const);
     function OnCondEvalVar(Sender: TCondDirectiveEvaluator; Name: String; out
       Value: string): boolean;
+    procedure SetAllowedBoolSwitches(const AValue: TBoolSwitches);
     procedure SetAllowedModeSwitches(const AValue: TModeSwitches);
+    procedure SetCurrentBoolSwitches(const AValue: TBoolSwitches);
     procedure SetCurrentModeSwitches(AValue: TModeSwitches);
+    procedure SetMacrosOn(const AValue: boolean);
     procedure SetOptions(AValue: TPOptions);
+    procedure SetReadOnlyBoolSwitches(const AValue: TBoolSwitches);
     procedure SetReadOnlyModeSwitches(const AValue: TModeSwitches);
   protected
     function FetchLine: boolean;
@@ -576,6 +593,7 @@ type
     procedure PushSkipMode;
     function HandleDirective(const ADirectiveText: String): TToken; virtual;
     function HandleLetterDirective(Letter: char; Enable: boolean): TToken; virtual;
+    procedure HandleBoolDirective(bs: TBoolSwitch; const Param: String); virtual;
     procedure HandleIFDEF(const AParam: String);
     procedure HandleIFNDEF(const AParam: String);
     procedure HandleIFOPT(const AParam: String);
@@ -588,7 +606,6 @@ type
     procedure HandleIncludeFile(Param: String); virtual;
     procedure HandleUnDefine(Param: String);virtual;
     function HandleInclude(const Param: String): TToken;virtual;
-    procedure HandleMacroDirective(const Param: String);virtual;
     procedure HandleMode(const Param: String);virtual;
     procedure HandleModeSwitch(const Param: String);virtual;
     function HandleMacro(AIndex: integer): TToken;virtual;
@@ -638,11 +655,14 @@ type
     Property TokenOptions : TTokenOptions Read FTokenOptions Write FTokenOptions;
     property Defines: TStrings read FDefines;
     property Macros: TStrings read FMacros;
-    property MacrosOn: boolean read FMacrosOn write FMacrosOn;
+    property MacrosOn: boolean read GetMacrosOn write SetMacrosOn;
     property OnDirective: TPScannerDirectiveEvent read FOnDirective write FOnDirective;
     property AllowedModeSwitches: TModeSwitches read FAllowedModeSwitches Write SetAllowedModeSwitches;
     property ReadOnlyModeSwitches: TModeSwitches read FReadOnlyModeSwitches Write SetReadOnlyModeSwitches;// always set, cannot be disabled
     property CurrentModeSwitches: TModeSwitches read FCurrentModeSwitches Write SetCurrentModeSwitches;
+    property AllowedBoolSwitches: TBoolSwitches read FAllowedBoolSwitches Write SetAllowedBoolSwitches;
+    property ReadOnlyBoolSwitches: TBoolSwitches read FReadOnlyBoolSwitches Write SetReadOnlyBoolSwitches;// cannot be changed by code
+    property CurrentBoolSwitches: TBoolSwitches read FCurrentBoolSwitches Write SetCurrentBoolSwitches;
     property Options : TPOptions read FOptions write SetOptions;
     property ForceCaret : Boolean read GetForceCaret;
     property LogEvents : TPScannerLogEvents read FLogEvents write FLogEvents;
@@ -856,6 +876,12 @@ const
     ,'REFERENCEINFO'  // Y
     ,''               // Z
    );
+
+  BoolSwitchNames: array[TBoolSwitch] of string = (
+    'Macro',
+    'ScopedEnums'
+    );
+
 const
   AllLanguageModes = [msFPC,msObjFPC,msDelphi,msTP7,msMac,msISO,msExtPas];
 
@@ -2192,6 +2218,8 @@ begin
   FAllowedModes:=AllLanguageModes;
   FCurrentModeSwitches:=FPCModeSwitches;
   FAllowedModeSwitches:=msAllFPCModeSwitches;
+  FCurrentBoolSwitches:=[];
+  FAllowedBoolSwitches:=bsAll;
   FConditionEval:=TCondDirectiveEvaluator.Create;
   FConditionEval.OnLog:=@OnCondEvalLog;
   FConditionEval.OnEvalVariable:=@OnCondEvalVar;
@@ -2621,16 +2649,6 @@ begin
     end
 end;
 
-procedure TPascalScanner.HandleMacroDirective(const Param: String);
-begin
-  if CompareText(Param,'on')=0 then
-    MacrosOn:=true
-  else if CompareText(Param,'off')=0 then
-    MacrosOn:=false
-  else
-    Error(nErrXExpectedButYFound,SErrXExpectedButYFound,['on',Param]);
-end;
-
 procedure TPascalScanner.HandleMode(const Param: String);
 
   procedure SetMode(const LangMode: TModeSwitch; const NewModeSwitches: TModeSwitches;
@@ -2866,6 +2884,17 @@ Var
   P : Integer;
   Handled: Boolean;
 
+  procedure DoBoolDirective(bs: TBoolSwitch);
+  begin
+    if bs in AllowedBoolSwitches then
+      begin
+      Handled:=true;
+      HandleBoolDirective(bs,Param);
+      end
+    else
+      Handled:=false;
+  end;
+
 begin
   Result:=tkComment;
   P:=Pos(' ',ADirectiveText);
@@ -2875,7 +2904,7 @@ begin
   Param:=ADirectiveText;
   Delete(Param,1,P);
   {$IFDEF VerbosePasDirectiveEval}
-  Writeln('Directive: "',Directive,'", Param : "',Param,'"');
+  Writeln('TPascalScanner.HandleDirective.Directive: "',Directive,'", Param : "',Param,'"');
   {$ENDIF}
 
   Case UpperCase(Directive) of
@@ -2911,26 +2940,28 @@ begin
       begin
       Handled:=true;
       Case UpperCase(Directive) of
+        'DEFINE':
+          HandleDefine(Param);
+        'ERROR':
+          HandleError(Param);
+        'HINT':
+          DoLog(mtHint,nUserDefined,SUserDefined,[Directive]);
         'I','INCLUDE':
           Result:=HandleInclude(Param);
         'MACRO':
-          HandleMacroDirective(Param);
+          DoBoolDirective(bsMacro);
         'MODE':
           HandleMode(Param);
         'MODESWITCH':
           HandleModeSwitch(Param);
-        'DEFINE':
-          HandleDefine(Param);
-        'ERROR':
-          HandleError(Param);
-        'WARNING':
-          DoLog(mtWarning,nUserDefined,SUserDefined,[Directive]);
         'NOTE':
           DoLog(mtNote,nUserDefined,SUserDefined,[Directive]);
-        'HINT':
-          DoLog(mtHint,nUserDefined,SUserDefined,[Directive]);
+        'SCOPEDENUMS':
+          DoBoolDirective(bsScopedEnums);
         'UNDEF':
           HandleUnDefine(Param);
+        'WARNING':
+          DoLog(mtWarning,nUserDefined,SUserDefined,[Directive]);
       else
         Handled:=false;
       end;
@@ -2958,6 +2989,27 @@ begin
     UnDefine(LetterSwitchNames[Letter]);
 end;
 
+procedure TPascalScanner.HandleBoolDirective(bs: TBoolSwitch;
+  const Param: String);
+var
+  NewValue: Boolean;
+begin
+  if CompareText(Param,'on')=0 then
+    NewValue:=true
+  else if CompareText(Param,'off')=0 then
+    NewValue:=false
+  else
+    Error(nErrXExpectedButYFound,SErrXExpectedButYFound,['on',Param]);
+  if (bs in CurrentBoolSwitches)=NewValue then exit;
+  if bs in ReadOnlyBoolSwitches then
+    DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,
+      [BoolSwitchNames[bs]])
+  else if NewValue then
+    Include(FCurrentBoolSwitches,bs)
+  else
+    Exclude(FCurrentBoolSwitches,bs);
+end;
+
 function TPascalScanner.DoFetchToken: TToken;
 var
   TokenStart: PChar;
@@ -3435,6 +3487,11 @@ begin
   Result:=toForceCaret in FTokenOptions;
 end;
 
+function TPascalScanner.GetMacrosOn: boolean;
+begin
+  Result:=bsMacro in FCurrentBoolSwitches;
+end;
+
 function TPascalScanner.OnCondEvalFunction(Sender: TCondDirectiveEvaluator;
   Name, Param: String; out Value: string): boolean;
 begin
@@ -3537,6 +3594,12 @@ begin
   Result:=false;
 end;
 
+procedure TPascalScanner.SetAllowedBoolSwitches(const AValue: TBoolSwitches);
+begin
+  if FAllowedBoolSwitches=AValue then Exit;
+  FAllowedBoolSwitches:=AValue;
+end;
+
 procedure TPascalScanner.SetAllowedModeSwitches(const AValue: TModeSwitches);
 begin
   if FAllowedModeSwitches=AValue then Exit;
@@ -3544,6 +3607,12 @@ begin
   CurrentModeSwitches:=FCurrentModeSwitches*AllowedModeSwitches;
 end;
 
+procedure TPascalScanner.SetCurrentBoolSwitches(const AValue: TBoolSwitches);
+begin
+  if FCurrentBoolSwitches=AValue then Exit;
+  FCurrentBoolSwitches:=AValue;
+end;
+
 procedure TPascalScanner.SetCurrentModeSwitches(AValue: TModeSwitches);
 var
   Old, AddedMS, RemovedMS: TModeSwitches;
@@ -3566,6 +3635,14 @@ begin
     end;
 end;
 
+procedure TPascalScanner.SetMacrosOn(const AValue: boolean);
+begin
+  if AValue then
+    Include(FCurrentBoolSwitches,bsMacro)
+  else
+    Exclude(FCurrentBoolSwitches,bsMacro);
+end;
+
 procedure TPascalScanner.DoLog(MsgType: TMessageType; MsgNumber: integer;
   const Msg: String; SkipSourceInfo: Boolean);
 begin
@@ -3608,6 +3685,12 @@ begin
       CurrentModeSwitches:=FPCModeSwitches
 end;
 
+procedure TPascalScanner.SetReadOnlyBoolSwitches(const AValue: TBoolSwitches);
+begin
+  if FReadOnlyBoolSwitches=AValue then Exit;
+  FReadOnlyBoolSwitches:=AValue;
+end;
+
 procedure TPascalScanner.SetReadOnlyModeSwitches(const AValue: TModeSwitches);
 begin
   if FReadOnlyModeSwitches=AValue then Exit;

+ 48 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -125,6 +125,8 @@ type
     procedure OnCheckElementParent(El: TPasElement; arg: pointer);
     procedure FreeSrcMarkers;
     procedure OnPasResolverLog(Sender: TObject; const Msg: String);
+    procedure ScannerDirective(Sender: TObject; Directive, Param: String;
+      var Handled: boolean);
   Protected
     FirstSrcMarker, LastSrcMarker: PSrcMarker;
     Procedure SetUp; override;
@@ -258,6 +260,8 @@ type
     Procedure TestEnumRange;
     Procedure TestEnum_ForIn;
     Procedure TestEnum_ForInRangeFail;
+    Procedure TestEnum_ScopedEnums;
+    Procedure TestEnum_ScopedEnumsFail;
 
     // operators
     Procedure TestPrgAssignment;
@@ -765,6 +769,7 @@ begin
   FModules:=TObjectList.Create(true);
   inherited SetUp;
   Parser.Options:=Parser.Options+[po_ResolveStandardTypes];
+  Scanner.OnDirective:=@ScannerDirective;
 end;
 
 procedure TCustomTestResolver.TearDown;
@@ -1932,6 +1937,21 @@ begin
   FResolverMsgs.Add(Item);
 end;
 
+procedure TCustomTestResolver.ScannerDirective(Sender: TObject; Directive,
+  Param: String; var Handled: boolean);
+var
+  aScanner: TPascalScanner;
+begin
+  if Handled then exit;
+  aScanner:=Sender as TPascalScanner;
+  aScanner.LastMsgType:=mtError;
+  aScanner.LastMsg:='unknown directive "'+Directive+'"';
+  aScanner.LastMsgPattern:=aScanner.LastMsg;
+  aScanner.LastMsgArgs:=[];
+  raise EScannerError.Create(aScanner.LastMsg);
+  if Param='' then ;
+end;
+
 function TCustomTestResolver.GetModules(Index: integer): TTestEnginePasResolver;
 begin
   Result:=TTestEnginePasResolver(FModules[Index]);
@@ -3399,6 +3419,34 @@ begin
   CheckResolverException('Cannot find an enumerator for the type "range.."',nCannotFindEnumeratorForType);
 end;
 
+procedure TTestResolver.TestEnum_ScopedEnums;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {$scopedenums on}',
+  '  TEnum = (red, green);',
+  'var e: TEnum;',
+  'begin',
+  '  e:=TEnum.red;'
+  ]);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestEnum_ScopedEnumsFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {$ScopedEnums on}',
+  '  TEnum = (red, green);',
+  'var e: TEnum;',
+  'begin',
+  '  e:=red;'
+  ]);
+  CheckResolverException(sIdentifierNotFound,nIdentifierNotFound);
+end;
+
 procedure TTestResolver.TestPrgAssignment;
 var
   El: TPasElement;