diff --git a/packages/fcl-passrc/src/pscanner.pp b/packages/fcl-passrc/src/pscanner.pp index 68686b4bfc..85b5ffac3d 100644 --- a/packages/fcl-passrc/src/pscanner.pp +++ b/packages/fcl-passrc/src/pscanner.pp @@ -84,6 +84,7 @@ const nResourceFileNotFound = 1034; nErrInvalidMultiLineLineEnding = 1035; nWarnIgnoringLinkLib = 1036; + nErrInvalidIndent = 1037; // resourcestring patterns of messages resourcestring @@ -125,6 +126,7 @@ resourcestring SNoResourceSupport = 'No support for resources of type "%s"'; SErrInvalidMultiLineLineEnding = 'Invalid multilinestring line ending type: use one of CR/LF/CRLF/SOURCE/PLATFORM' ; SWarnIgnoringLinkLib = 'Ignoring LINKLIB directive %s -> %s (Options: %s)'; + SErrInvalidIndent = ' Inconsistent indent characters'; type {$IFDEF PAS2JS} @@ -338,7 +340,8 @@ type msExternalClass, { pas2js: Allow external class definitions } msOmitRTTI, { pas2js: treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch } - msMultiLineStrings { pas2js: Multiline strings } + msMultiLineStrings, { pas2js: Multiline strings } + msDelphiMultiLineStrings { Delpi-compatible multiline strings } ); TModeSwitches = Set of TModeSwitch; @@ -765,6 +768,7 @@ type State: TWarnMsgState; end; TWarnMsgNumberStateArr = array of TWarnMsgNumberState; + procedure HandleTextBlock(const AParam: TPasScannerString); private FAllowedBoolSwitches: TBoolSwitches; FAllowedModeSwitches: TModeSwitches; @@ -854,8 +858,10 @@ type procedure AddFile(aFilename: TPasScannerString); virtual; function GetMacroName(const Param: TPasScannerString): TPasScannerString; procedure SetCurMsg(MsgType: TMessageType; MsgNumber: integer; Const Fmt : TPasScannerString; Args : Array of const); + procedure SetCurMsg(MsgType: TMessageType; MsgNumber: integer; Const Msg : TPasScannerString); Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Msg : TPasScannerString; SkipSourceInfo : Boolean = False);overload; Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Fmt : TPasScannerString; Args : Array of const;SkipSourceInfo : Boolean = False);overload; + procedure ErrorAt(MsgNumber: integer; const Msg: TPasScannerString; aRow,ACol : Integer);overload; procedure Error(MsgNumber: integer; const Msg: TPasScannerString);overload; procedure Error(MsgNumber: integer; const Fmt: TPasScannerString; Args: array of const);overload; procedure PushSkipMode; @@ -904,6 +910,7 @@ type procedure PopStackItem; virtual; function DoFetchTextToken: TToken; // including quotes function DoFetchMultilineTextToken: TToken; // back ticks are converted to apostrophs, unindented + function DoFetchDelphiMultiLineTextToken(quotelen: Integer): TToken; function DoFetchToken: TToken; procedure ClearFiles; Procedure ClearMacros; @@ -1179,7 +1186,8 @@ const 'ANONYMOUSFUNCTIONS', 'EXTERNALCLASS', 'OMITRTTI', - 'MULTILINESTRINGS' + 'MULTILINESTRINGS', + 'DELPHIMULTILINESTRINGS' ); LetterSwitchNames: array['A'..'Z'] of TPasScannerString=( @@ -1322,7 +1330,9 @@ const Digits = ['0'..'9']; Letters = ['a'..'z','A'..'Z']; HexDigits = ['0'..'9','a'..'f','A'..'F']; - + SingleQuote = #39; + TripleQuote = #39#39#39; + Var SortedTokens : array of TToken; LowerCaseTokens : Array[ttoken] of TPasScannerString; @@ -3756,11 +3766,16 @@ begin until false; end; -procedure TPascalScanner.Error(MsgNumber: integer; const Msg: TPasScannerString); +procedure TPascalScanner.ErrorAt(MsgNumber: integer; const Msg: TPasScannerString; aRow, ACol: Integer); begin SetCurMsg(mtError,MsgNumber,Msg,[]); raise EScannerError.CreateFmt('%s(%d,%d) Error: %s', - [FormatPath(CurFilename),CurRow,CurColumn,FLastMsg]); + [FormatPath(CurFilename),aRow,aCol,FLastMsg]); +end; + +procedure TPascalScanner.Error(MsgNumber: integer; const Msg: TPasScannerString); +begin + ErrorAt(MsgNumber,Msg,CurRow,CurColumn); end; procedure TPascalScanner.Error(MsgNumber: integer; const Fmt: TPasScannerString; @@ -4100,6 +4115,105 @@ begin until false; end; +function TPascalScanner.DoFetchDelphiMultiLineTextToken(quotelen : Integer): TToken; +// works similar to DoFetchTextToken, except changes indentation + +var + StartPos: Integer; + TokenStart: {$ifdef UsePChar}PAnsiChar{$else}integer{$endif}; + {$ifndef UsePChar} + s: TPasScannerString; + l: integer; + {$endif} + Msg,CurLF : TPasScannerString; + Lines : Array of String; + I,SpaceCount,QuoteCount,WhiteSpaces,CurLines : Integer; + + Procedure AddToLines; + + var + L : Integer; + + begin + L:=Length(Lines); + if CurLines=L then + SetLength(Lines,L+10); + Lines[CurLines]:=FCurLine; + Inc(CurLines); + end; + + Function LocalFetchLine : Boolean; + + begin + // Writeln('Curtokenstring : >>',FCurTokenString,'<<'); + Result:=Self.FetchLine; + if not Result then + Error(nErrOpenString,SErrOpenString); + // Writeln('Current line is now : ',FCurLine); + {$IFDEF UsePChar} + FTokenPos:=PAnsiChar(FCurLine); + {$ELSE} + s:=FCurLine; + l:=length(s); + {$ENDIF} + TokenStart:=FTokenPos; + end; + +begin + Lines:=[]; + CurLines:=0; + Result:=tkEOF; + FCurTokenString := ''; + // On entry, we know that the current position is the start of the multiline quoted string. + // the strings are added as-is. + repeat + QuoteCount:=0; + WhiteSpaces:=0; + if not LocalFetchLine then + exit(tkEOF); + // Skip whitespace, but count. + While FTokenPos[0]=' ' do + begin + Inc(FTokenPos); + Inc(WhiteSpaces); + end; + // Count quotes + While (FTokenPos[0]=SingleQuote) and (QuoteCountQuoteLen then + AddToLines; + Until QuoteCount=QuoteLen; + if (QuoteCount=0) then + Exit(tkEOF); + // Final string Construction + FCurTokenString:=SingleQuote; + CurLF:=GetMultiLineStringLineEnd(FCurSourceFile); + For I:=0 to CurLines-1 do + begin + if I>0 then + FCurTokenString:=FCurTokenString+CurLf; + If Lines[I]<>'' then + begin + TokenStart:=@Lines[I][1]; + SpaceCount:=0; + While (TokenStart[0]=' ') and (SpaceCount1 then + Parm:=Copy(Parm,1,P-1); + Case Parm of + 'CR' : s:=elCR; + 'LF' : s:=elLF; + 'CRLF' : s:=elCRLF; + 'NATIVE' : s:=elPlatform; + else + Error(nErrInvalidMultiLineLineEnding,sErrInvalidMultiLineLineEnding); + end; + MultilineStringsEOLStyle:=S; +end; + procedure TPascalScanner.HandleMultilineStringLineEnding(const AParam: TPasScannerString); Var @@ -5367,7 +5506,7 @@ function TPascalScanner.DoFetchToken: TToken; var TokenStart: {$ifdef UsePChar}PAnsiChar{$else}integer{$endif}; i: TToken; - SectionLength, Index: Integer; + QuoteLen,SectionLength, Index: Integer; {$ifdef UsePChar} // {$else} @@ -5396,6 +5535,34 @@ var {$endif} end; + {$ifdef UsePChar} + Function IsDelphiMultiLine (out QuoteLen : integer): Boolean; + var + P : PAnsiChar; + I : Integer; + begin + P:=FTokenPos; + QuoteLen:=0; + While P[0]<>#0 do + begin + inc(QuoteLen); + if P[0]<>SingleQuote then + Exit(false); + Inc(P); + end; + Result:=(P[0]=#0) and (QuoteLen>2) and ((QuoteLen mod 2) = 1); + end; + {$ELSE} + Function IsDelphiMultiLine(out Quotelen : integer) Boolean; + + begin + if (FTokenPos<>L-2) then + exit(false); + // Accessing single char is more expensive than a copy + Result:=(Copy(S,FTokenPos,3)=TripleQuote); + end; + {$ENDIF} + begin FCurtokenEscaped:=False; TokenStart:={$ifdef UsePChar}nil{$else}0{$endif}; @@ -5456,8 +5623,13 @@ begin end; until not ({$ifdef UsePChar}FTokenPos[0]{$else}s[FTokenPos]{$endif}=#9); end; - '#', '''': + '#': Result:=DoFetchTextToken; + #39: + if (msDelphiMultiLineStrings in CurrentModeSwitches) and IsDelphiMultiLine(Quotelen) then + Result:=DoFetchDelphiMultiLineTextToken(Quotelen) + else + Result:=DoFetchTextToken; '`' : begin If not (msMultiLineStrings in CurrentModeSwitches) then @@ -6180,6 +6352,7 @@ begin end; end; + procedure TPascalScanner.SetOptions(AValue: TPOptions); Var @@ -6321,6 +6494,16 @@ begin CreateMsgArgs(FLastMsgArgs,Args); end; +procedure TPascalScanner.SetCurMsg(MsgType: TMessageType; MsgNumber: integer; const Msg: TPasScannerString); +begin + FLastMsgType := MsgType; + FLastMsgNumber := MsgNumber; + FLastMsgPattern := ''; + FLastMsgArgs:=[]; + FLastMsg := Msg; + +end; + function TPascalScanner.AddDefine(const aName: TPasScannerString; Quiet: boolean): boolean; begin diff --git a/packages/fcl-passrc/tests/tcscanner.pas b/packages/fcl-passrc/tests/tcscanner.pas index 4080b0751c..6b7440b397 100644 --- a/packages/fcl-passrc/tests/tcscanner.pas +++ b/packages/fcl-passrc/tests/tcscanner.pas @@ -9,6 +9,11 @@ interface uses Classes, SysUtils, typinfo, fpcunit, testregistry, pscanner; +Const + SingleQuote = #39; + DoubleQuote = #39#39; + TripleQuote = #39#39#39; + type { TTestTokenFinder } @@ -65,6 +70,9 @@ type FComment: string; FPathPrefix : String; FTestTokenString: String; + FMultiLine : String; + procedure DoTestDelphiMultiLine; + procedure DoTestDelphiMultiLineString; protected procedure DoComment(Sender: TObject; aComment: TPasScannerString); procedure DoLinkLib(Sender: TObject; const aLibName,aAlias,aOptions : TPasScannerString; var aHandled : Boolean); @@ -72,10 +80,13 @@ type procedure TearDown; override; Procedure DoMultilineError; Function TokenToString(tk : TToken) : string; + class Function CreateDelphiMultiLine(Lines : Array of string; PrefixCount : Byte = 2; Suffix : String = '';QuoteCount : Integer=3) : string; Procedure AssertEquals(Msg : String; Expected,Actual : TToken); overload; Procedure AssertEquals(Msg : String; Expected,Actual : TModeSwitch); overload; Procedure AssertEquals(Msg : String; Expected,Actual : TModeSwitches); overload; + Procedure AssertEquals(Msg : String; Expected,Actual : TEOLStyle); overload; + // creates a virtual source file with name 'afile.pp', prepended with PathPrefix procedure NewSource(Const Source : RawBytestring; DoClear : Boolean = True); Procedure DoTestToken(t : TToken; Const ASource : RawByteString; Const CheckEOF : Boolean = True); @@ -127,6 +138,16 @@ type procedure TestMultilineStringTrimAll; procedure TestMultilineStringTrimAuto; procedure TestMultilineStringTrim2; + Procedure TestDelphiMultiLine; + procedure TestDelphiMultiLineNotEnabled; + procedure TestDelphiMultiLineWrongIndent; + procedure TestDelphiMultiLineSpecial1; + procedure TestDelphiMultiLineSpecial2; + procedure TestDelphiMultiLineTrailingGarbage1; + procedure TestDelphiMultiLineTrailingGarbage2; + procedure TestDelphiMultiLineTrailingGarbage3; + procedure TestDelphiMultiLineEmbeddedQuotes; + Procedure TestTextBlockDirective; procedure TestNumber; procedure TestChar; procedure TestCharString; @@ -478,6 +499,20 @@ begin Result:=GetEnumName(TypeInfo(TToken),Ord(tk)); end; +class function TTestScanner.CreateDelphiMultiLine(Lines: array of string; PrefixCount: Byte; Suffix: String = '';QuoteCount : Integer=3): string; + +Var + Quotes,S,Prefix : String; + +begin + Prefix:=StringOfChar(' ',PrefixCount); + Quotes:=StringOfChar(SingleQuote,QuoteCount); + Result:=Prefix+Quotes+sLineBreak; + For S in Lines do + Result:=Result+Prefix+S+sLineBreak; + Result:=Result+Prefix+Quotes+Suffix+sLineBreak; +end; + procedure TTestScanner.AssertEquals(Msg: String; Expected, Actual: TToken); begin AssertEquals(Msg,TokenToString(Expected),TokenToString(Actual)); @@ -511,6 +546,12 @@ begin AssertEquals(Msg,ToString(Expected),ToString(Actual)); end; +procedure TTestScanner.AssertEquals(Msg: String; Expected, Actual: TEOLStyle); +begin + AssertEquals(Msg,GetEnumName(TypeInfo(TEOLStyle),Ord(Expected)), + GetEnumName(TypeInfo(TEOLStyle),Ord(Actual))) +end; + procedure TTestScanner.NewSource(const Source: RawBytestring; DoClear : Boolean = True); Const @@ -592,7 +633,9 @@ begin begin tk:=FScanner.FetchToken; if (tk=tkLineEnding) then - tk:=FScanner.FetchToken; + tk:=FScanner.FetchToken + else if not (tk in [tkComment,tkEOF]) then + AssertEquals('Wrong character, expected lineending.',tkLineEnding,tk); AssertEquals('EOF reached.',tkEOF,FScanner.FetchToken); end; end; @@ -875,6 +918,144 @@ begin AssertEquals('Correct trim 2',S2,TestTokenString); end; + +procedure TTestScanner.DoTestDelphiMultiLineString; + +begin + TestTokens([pscanner.tkWhitespace,pscanner.tkString],FMultiLine); +end; + +procedure TTestScanner.DoTestDelphiMultiLine; + +var + S1,S2 : String; +begin + S1:='Line 1'; + S2:='Line 2'; + FMultiLine:=CreateDelphiMultiLine([S1,S2]); + DoTestDelphiMultiLineString; +end; + + +procedure TTestScanner.TestDelphiMultiLineNotEnabled; + +begin + AssertException('Must be enabled',EScannerError,@DoTestDelphiMultiLine); +end; + +procedure TTestScanner.TestDelphiMultiLineWrongIndent; +var + Prefix,S1,S2 : String; +begin + S1:='Line 1'; + S2:='Line 2'; + Prefix:=' '; + FMultiLine:=Prefix+TripleQuote+sLineBreak; // Line 1 + FMultiLine:=FMultiLine+Prefix+S1+sLineBreak; // Line 2 + FMultiLine:=FMultiLine+' '+S2+sLineBreak; // Line 3, 2 indent so error col is 2. + FMultiLine:=FMultiLine+Prefix+TripleQuote+sLineBreak; // Line 4 + Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings]; + // We check the error message for the displayed line number and column. + AssertException('Wrong indent',EScannerError,@DoTestDelphiMultiLineString,'afile.pp(3,2) Error: Inconsistent indent characters'); +end; + +procedure TTestScanner.TestDelphiMultiLineSpecial1; + +var + S1,S2 : String; + +begin + S1:='Line 1 ''#39'; + S2:='Line 2'; + FMultiLine:=CreateDelphiMultiLine([S1,S2]); + Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings]; + DoTestDelphiMultiLineString; + AssertEquals('Correct string',SingleQuote+S1+sLineBreak+S2+SingleQuote,TestTokenString); +end; + +procedure TTestScanner.TestDelphiMultiLineSpecial2; +var + S1,S2 : String; + +begin + S1:='Line 1 ''^A'; + S2:='Line 2'; + FMultiLine:=CreateDelphiMultiLine([S1,S2]); + Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings]; + DoTestDelphiMultiLineString; + AssertEquals('Correct string',SingleQuote+S1+sLineBreak+S2+SingleQuote,TestTokenString); +end; + +procedure TTestScanner.TestDelphiMultiLineTrailingGarbage1; +var + S1,S2 : String; + +begin + S1:='Line 1'; + S2:='Line 2'; + FMultiLine:=CreateDelphiMultiLine([S1,S2],2,SingleQuote); + Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings]; + // test on actual error message, we need + AssertException('Trailing garbage leads to error',EScannerError,@DoTestDelphiMultiLineString,'afile.pp(4,7) Error: string exceeds end of line'); +end; + +procedure TTestScanner.TestDelphiMultiLineTrailingGarbage2; + +var + S1,S2 : String; + +begin + S1:='Line 1 '; + S2:='Line 2'; + FMultiLine:=CreateDelphiMultiLine([S1,S2],2,'^A'); + Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings]; + // EAssertionFailedError because the last token is a Dereferencing token + AssertException('Trailing garbage leads to error',EAssertionFailedError,@DoTestDelphiMultiLineString,'"Wrong character, expected lineending." expected: but was: '); +end; + +procedure TTestScanner.TestDelphiMultiLineTrailingGarbage3; + +var + S1,S2 : String; + +begin + S1:='Line 1 '; + S2:='Line 2'; + FMultiLine:=CreateDelphiMultiLine([S1,S2],2,'#01'); + Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings]; + // EAssertionFailedError because the last token is a Dereferencing token + AssertException('Trailing garbage leads to error',EAssertionFailedError,@DoTestDelphiMultiLineString,'"Wrong character, expected lineending." expected: but was: '); +end; + +procedure TTestScanner.TestDelphiMultiLineEmbeddedQuotes; +var + S1,S2,S3 : String; + +begin + S1:='Line 1 '; + S2:='Line 2 '+TripleQuote; + S3:='Line 2'; + FMultiLine:=CreateDelphiMultiLine([S1,S2,S3],2,'',5); + Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings]; + DoTestDelphiMultiLineString; + AssertEquals('Correct string',SingleQuote+S1+sLineBreak+S2+sLineBreak+S3+SingleQuote,TestTokenString); +end; + + +procedure TTestScanner.TestDelphiMultiLine; + +var + S1,S2 : String; + +begin + S1:='Line 1'; + S2:='Line 2'; + FMultiLine:=CreateDelphiMultiLine([S1,S2]); + Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings]; + DoTestDelphiMultiLineString; + AssertEquals('Correct string',SingleQuote+S1+sLineBreak+S2+SingleQuote,TestTokenString); +end; + procedure TTestScanner.TestCharString; begin @@ -2255,6 +2436,21 @@ begin AssertEquals('Library options','opt1, opt2',LibOptions); end; +procedure TTestScanner.TestTextBlockDirective; +begin + DoTestToken(tkComment,'{$TEXTBLOCK LF}'); + AssertEquals('Correct EOL style',elLF,Scanner.MultilineStringsEOLStyle); + DoTestToken(tkComment,'{$TEXTBLOCK CRLF}'); + AssertEquals('Correct EOL style',elCRLF,Scanner.MultilineStringsEOLStyle); + DoTestToken(tkComment,'{$TEXTBLOCK CR}'); + AssertEquals('Correct EOL style',elCR,Scanner.MultilineStringsEOLStyle); + DoTestToken(tkComment,'{$TEXTBLOCK NATIVE}'); + AssertEquals('Correct EOL style',elPlatform,Scanner.MultilineStringsEOLStyle); + // Ident allowed after... + DoTestToken(tkComment,'{$TEXTBLOCK NATIVE XYZ}'); + AssertEquals('Correct EOL style',elPlatform,Scanner.MultilineStringsEOLStyle); +end; + initialization RegisterTests([TTestTokenFinder,TTestStreamLineReader,TTestScanner]); end. diff --git a/packages/fcl-passrc/tests/testpassrc.lpi b/packages/fcl-passrc/tests/testpassrc.lpi index 59ec89ea6d..7ffbc7f023 100644 --- a/packages/fcl-passrc/tests/testpassrc.lpi +++ b/packages/fcl-passrc/tests/testpassrc.lpi @@ -27,13 +27,13 @@ - + - + @@ -141,9 +141,11 @@ - - - + + + + +