paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 07:09:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: fixed modeswitch param and comment to be fpc compatible

Browse Source 
git-svn-id: trunk@43285 -
This commit is contained in:
Mattias Gaertner 2019-10-21 10:26:23 +00:00
parent d90741d2f2
commit ddcb2d80af
4 changed files with 75 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
packages/fcl-passrc/src/pasresolver.pp
View File

@ -338,7 +338,6 @@ const
po_NoOverloadedProcs,
po_KeepClassForward,
po_ArrayRangeExpr,
po_CheckModeswitches,
po_CheckCondFunction];
type

77
packages/fcl-passrc/src/pscanner.pp
View File

@ -80,6 +80,7 @@ const
nMisplacedGlobalCompilerSwitch = 1029;
nLogMacroXSetToY = 1030;
nInvalidDispatchFieldName = 1031;
nErrWrongSwitchToggle = 1032;
// resourcestring patterns of messages
resourcestring
@ -116,6 +117,7 @@ resourcestring
SMisplacedGlobalCompilerSwitch = 'Misplaced global compiler switch, ignored';
SLogMacroXSetToY = 'Macro %s set to %s';
SInvalidDispatchFieldName = 'Invalid Dispatch field name';
SErrWrongSwitchToggle = 'Wrong switch toggle, use ON/OFF or +/-';
type
TMessageType = (
@ -2502,7 +2504,6 @@ function TFileResolver.FindIncludeFileName(const AName: string): String;
end;
var
i: Integer;
FN : string;
begin
@ -3496,36 +3497,74 @@ begin
end;
procedure TPascalScanner.HandleModeSwitch(const Param: String);
// $modeswitch param
// name, name-, name+, name off, name on, name- comment, name on comment
Var
MS : TModeSwitch;
MSN,PM : String;
P : Integer;
p : Integer;
Enable: Boolean;
begin
MSN:=Uppercase(Param);
P:=Pos(' ',MSN);
if P<>0 then
begin
PM:=Trim(Copy(MSN,P+1,Length(MSN)-P));
MSN:=Copy(MSN,1,P-1);
end;
PM:=Param;
p:=1;
while (p<=length(PM)) and (PM[p] in ['a'..'z','A'..'Z','_','0'..'9']) do
inc(p);
MSN:=LeftStr(PM,p-1);
Delete(PM,1,p-1);
MS:=StrToModeSwitch(MSN);
if (MS=msNone) or not (MS in AllowedModeSwitches) then
begin
if po_CheckModeSwitches in Options then
Error(nErrInvalidModeSwitch,SErrInvalidModeSwitch,[Param])
Error(nErrInvalidModeSwitch,SErrInvalidModeSwitch,[MSN])
else
exit; // ignore
DoLog(mtWarning,nErrInvalidModeSwitch,SErrInvalidModeSwitch,[MSN]);
exit; // ignore
end;
if (PM='-') or (PM='OFF') then
begin
if MS in ReadOnlyModeSwitches then
Error(nErrInvalidModeSwitch,SErrInvalidModeSwitch,[Param]);
CurrentModeSwitches:=CurrentModeSwitches-[MS]
end
if PM='' then
Enable:=true
else
CurrentModeSwitches:=CurrentModeSwitches+[MS];
case PM[1] of
'+','-':
begin
Enable:=PM[1]='+';
p:=2;
if (p<=length(PM)) and not (PM[p] in [' ',#9]) then
Error(nErrWrongSwitchToggle,SErrWrongSwitchToggle,[]);
end;
' ',#9:
begin
PM:=TrimLeft(PM);
if PM<>'' then
begin
p:=1;
while (p<=length(PM)) and (PM[p] in ['A'..'Z']) do inc(p);
if (p<=length(PM)) and not (PM[p] in [' ',#9]) then
Error(nErrWrongSwitchToggle,SErrWrongSwitchToggle,[]);
PM:=LeftStr(PM,p-1);
if PM='ON' then
Enable:=true
else if PM='OFF' then
Enable:=false
else
Error(nErrWrongSwitchToggle,SErrWrongSwitchToggle,[]);
end;
end;
else
Error(nErrWrongSwitchToggle,SErrWrongSwitchToggle,[]);
end;
if MS in CurrentModeSwitches=Enable then
exit; // no change
if MS in ReadOnlyModeSwitches then
begin
DoLog(mtWarning,nErrInvalidModeSwitch,SErrInvalidModeSwitch,[MSN]);
exit;
end;
if Enable then
CurrentModeSwitches:=CurrentModeSwitches+[MS]
else
CurrentModeSwitches:=CurrentModeSwitches-[MS];
end;
procedure TPascalScanner.PushSkipMode;

19
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -131,8 +131,9 @@ type
procedure OnCheckElementParent(El: TPasElement; arg: pointer);
procedure FreeSrcMarkers;
procedure OnPasResolverLog(Sender: TObject; const Msg: String);
procedure ScannerDirective(Sender: TObject; Directive, Param: String;
procedure OnScannerDirective(Sender: TObject; Directive, Param: String;
var Handled: boolean);
procedure OnScannerLog(Sender: TObject; const Msg: String);
Protected
FirstSrcMarker, LastSrcMarker: PSrcMarker;
Procedure SetUp; override;
@ -1050,7 +1051,8 @@ begin
FModules:=TObjectList.Create(true);
inherited SetUp;
Parser.Options:=Parser.Options+[po_ResolveStandardTypes];
Scanner.OnDirective:=@ScannerDirective;
Scanner.OnDirective:=@OnScannerDirective;
Scanner.OnLog:=@OnScannerLog;
end;
procedure TCustomTestResolver.TearDown;
@ -2548,7 +2550,7 @@ begin
FResolverMsgs.Add(Item);
end;
procedure TCustomTestResolver.ScannerDirective(Sender: TObject; Directive,
procedure TCustomTestResolver.OnScannerDirective(Sender: TObject; Directive,
Param: String; var Handled: boolean);
var
aScanner: TPascalScanner;
@ -2563,6 +2565,17 @@ begin
if Param='' then ;
end;
procedure TCustomTestResolver.OnScannerLog(Sender: TObject; const Msg: String);
var
aScanner: TPascalScanner;
begin
aScanner:=TPascalScanner(Sender);
if aScanner=nil then exit;
{$IFDEF VerbosePasResolver}
writeln('TCustomTestResolver.OnScannerLog ',GetObjName(Sender),' ',aScanner.LastMsgType,' ',aScanner.LastMsgNumber,' Msg="', Msg,'"');
{$ENDIF}
end;
function TCustomTestResolver.GetModules(Index: integer): TTestEnginePasResolver;
begin
Result:=TTestEnginePasResolver(FModules[Index]);

2
packages/fcl-passrc/tests/tcscanner.pas
View File

@ -1730,7 +1730,7 @@ begin
if SModeSwitchNames[M]<>'' then
begin
Scanner.CurrentModeSwitches:=[];
NewSource('{$MODESWITCH '+SModeSwitchNames[M]+' '+C+'}');
NewSource('{$MODESWITCH '+SModeSwitchNames[M]+C+'}');
While not (Scanner.FetchToken=tkEOF) do;
if C in [' ','+'] then
AssertTrue(SModeSwitchNames[M]+C+' sets '+GetEnumName(TypeInfo(TModeSwitch),Ord(M)),M in Scanner.CurrentModeSwitches)