From 34c3ed4df780911a04f00834e569749e04aec8fc Mon Sep 17 00:00:00 2001 From: mattias Date: Tue, 29 May 2007 23:49:11 +0000 Subject: [PATCH] codetools: fixed $ELIFC and $ELSEIF git-svn-id: trunk@11222 - --- components/codetools/examples/addmethod.lpr | 6 +- .../codetools/examples/finddeclaration.lpr | 10 +- .../examples/scanexamples/modemacpas.pas | 32 +- components/codetools/linkscanner.pas | 352 +++++++++--------- 4 files changed, 197 insertions(+), 203 deletions(-) diff --git a/components/codetools/examples/addmethod.lpr b/components/codetools/examples/addmethod.lpr index c2c63f9540..801fe01788 100644 --- a/components/codetools/examples/addmethod.lpr +++ b/components/codetools/examples/addmethod.lpr @@ -47,12 +47,12 @@ begin // Example: find declaration of 'TObject' // load the file - Filename:=AppendPathDelim(GetCurrentDir) - +'scanexamples'+PathDelim+'simpleunit1.pas'; + Filename:=AppendPathDelim(GetCurrentDir)+'scanexamples'+PathDelim + +'simpleunit1.pas'; Code:=CodeToolBoss.LoadFile(Filename,false,false); if Code=nil then raise Exception.Create('loading failed '+Filename); - + // Example 1: add a method compatible to TMyMethodType if CodeToolBoss.CreatePublishedMethod(Code,'TMyClass','NewMethod', typeinfo(TMyMethodType),true) then diff --git a/components/codetools/examples/finddeclaration.lpr b/components/codetools/examples/finddeclaration.lpr index f2ec55b684..f192307501 100644 --- a/components/codetools/examples/finddeclaration.lpr +++ b/components/codetools/examples/finddeclaration.lpr @@ -51,18 +51,18 @@ begin { Linux } Options.FPCPath:='/usr/bin/ppc386'; Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc'); + Options.FPCSrcDir:=ExpandFileName('/home/mattias/pascal/fpc_sources/22/fpc'); Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus'); { Windows - Options.FPCPath:='C:\lazarus\fpc\2.0.4\bin\i386-win32\ppc386.exe'; //'/usr/bin/ppc386'; - Options.FPCSrcDir:='C:\lazarus\fpc\2.0.4\source'; // ExpandFileName('~/freepascal/fpc'); - Options.LazarusSrcDir:='C:\lazarus\'; // ExpandFileName('~/pascal/lazarus');} + Options.FPCPath:='C:\lazarus\fpc\2.0.4\bin\i386-win32\ppc386.exe'; + Options.FPCSrcDir:='C:\lazarus\fpc\2.0.4\source'; + Options.LazarusSrcDir:='C:\lazarus\';} // optional: ProjectDir and TestPascalFile exists only to easily test some // things. Options.ProjectDir:=SetDirSeparators(GetCurrentDir+'/scanexamples/'); - //Options.TestPascalFile:=Options.ProjectDir+'simpleunit1.pas'; - Options.TestPascalFile:=Options.ProjectDir+'modemacpas.pas'; + Options.TestPascalFile:=Options.ProjectDir+'simpleunit1.pas'; // init the codetools if not Options.UnitLinkListValid then diff --git a/components/codetools/examples/scanexamples/modemacpas.pas b/components/codetools/examples/scanexamples/modemacpas.pas index 900b61c51b..ce04f55614 100644 --- a/components/codetools/examples/scanexamples/modemacpas.pas +++ b/components/codetools/examples/scanexamples/modemacpas.pas @@ -7,19 +7,29 @@ interface uses Classes, SysUtils; -{$ifc defined FPC_BIG_ENDIAN} -aaa1 - {$setc TARGET_RT_BIG_ENDIAN := TRUE} - {$setc TARGET_RT_LITTLE_ENDIAN := FALSE} -{$elifc defined FPC_LITTLE_ENDIAN} -aaa2 - {$setc TARGET_RT_BIG_ENDIAN := FALSE} - {$setc TARGET_RT_LITTLE_ENDIAN := TRUE} +{$DEFINE test3} +{$DEFINE bogus4} + +{$ifc defined test1} +type aaa1 = integer; +{$elifc defined test2} +type aaa2 = integer; +{$elifc defined test3} +type aaa3 = integer; + {$ifc defined bogus1} + type bogus1 = integer; + {$elifc defined bogus2} + type bogus2 = integer; + {$elifc defined bogus3} + type bogus3 = integer; + {$elsec} + type bogusELSE = integer; + {$error Neither bogus1 nor bogus2 nor bogus3 are defined.} + {$endc} {$elsec} -aaa3 - {$error Neither FPC_BIG_ENDIAN nor FPC_LITTLE_ENDIAN are defined.} +type aaaELSE = integer; + {$error Neither test1 nor test2 nor test3 are defined.} {$endc} -aaa implementation diff --git a/components/codetools/linkscanner.pas b/components/codetools/linkscanner.pas index 843f053dda..c16d4c9624 100644 --- a/components/codetools/linkscanner.pas +++ b/components/codetools/linkscanner.pas @@ -107,6 +107,12 @@ type TCompilerMode = (cmFPC, cmDELPHI, cmGPC, cmTP, cmOBJFPC, cmMacPas); TPascalCompiler = (pcFPC, pcDelphi); + + TLSSkippingDirective = ( + lssdNone, + lssdTillElse, + lssdTillEndIf + ); { TMissingIncludeFile is a missing include file together with all params involved in the search } @@ -153,7 +159,7 @@ type constructor Create(ASender: TLinkScanner; const AMessage: string; ABuffer: Pointer; ABufferPos: integer); end; - + { TLinkScanner } TLinkScanner = class(TObject) @@ -233,18 +239,19 @@ type // directives FDirectiveName: shortstring; FDirectiveFuncList: TKeyWordFunctionList; + FDefaultDirectiveFuncList: TKeyWordFunctionList; FSkipDirectiveFuncList: TKeyWordFunctionList; FMacrosOn: boolean; FMissingIncludeFiles: TMissingIncludeFiles; FIncludeStack: TFPList; // list of TSourceLink - FSkippingTillEndif: boolean; + FSkippingDirectives: TLSSkippingDirective; FSkipIfLevel: integer; FCompilerMode: TCompilerMode; FPascalCompiler: TPascalCompiler; procedure SetCompilerMode(const AValue: TCompilerMode); - procedure SkipTillEndifElse; - procedure SkipTillEndCifElse; + procedure SkipTillEndifElse(SkippingUntil: TLSSkippingDirective); function SkipIfDirective: boolean; + function InternalIfDirective: boolean; function IfdefDirective: boolean; function IfCDirective: boolean; function IfndefDirective: boolean; @@ -252,11 +259,11 @@ type function IfOptDirective: boolean; function EndifDirective: boolean; function EndCDirective: boolean; + function IfEndDirective: boolean; function ElseDirective: boolean; function ElseCDirective: boolean; function ElseIfDirective: boolean; function ElIfCDirective: boolean; - function IfEndDirective: boolean; function DefineDirective: boolean; function UndefDirective: boolean; function SetCDirective: boolean; @@ -659,7 +666,7 @@ begin Values.Free; FInitValues.Free; ReAllocMem(FLinks,0); - FDirectiveFuncList.Free; + FDefaultDirectiveFuncList.Free; FSkipDirectiveFuncList.Free; inherited Destroy; end; @@ -1086,7 +1093,8 @@ begin CompilerMode:=cmFPC; PascalCompiler:=pcFPC; IfLevel:=0; - FSkippingTillEndif:=false; + FSkippingDirectives:=lssdNone; + FDirectiveFuncList:=FDefaultDirectiveFuncList; //DebugLn('TLinkScanner.Scan D --------'); // initialize Defines @@ -1149,11 +1157,15 @@ begin LastTokenType:=TokenType; until false; finally - if not FSkippingTillEndif then begin + if FSkippingDirectives=lssdNone then begin {$IFDEF ShowUpdateCleanedSrc} DebugLn('TLinkScanner.Scan UpdatePos=',DbgS(SrcPos-1)); {$ENDIF} UpdateCleanedSource(SrcPos-1); + end else begin + {$IFDEF ShowUpdateCleanedSrc} + DebugLn(['TLinkScanner.Scan missing $ENDIF']); + {$ENDIF} end; end; IncreaseChangeStep; @@ -2003,8 +2015,8 @@ end; procedure TLinkScanner.BuildDirectiveFuncList; var c: char; begin - FDirectiveFuncList:=TKeyWordFunctionList.Create; - with FDirectiveFuncList do begin + FDefaultDirectiveFuncList:=TKeyWordFunctionList.Create; + with FDefaultDirectiveFuncList do begin for c:='A' to 'Z' do begin if CompilerSwitchesNames[c]<>'' then begin Add(c,{$ifdef FPC}@{$endif}ShortSwitchDirective); @@ -2155,26 +2167,16 @@ begin SkipSpace; VariableName:=ReadUpperIdentifier; if (VariableName<>'') and (not Values.IsDefined(VariableName)) then - SkipTillEndifElse; + SkipTillEndifElse(lssdTillElse); Result:=true; end; function TLinkScanner.IfCDirective: boolean; // {$ifc expression} or indirectly called by {$elifc expression} -var Expr, ResultStr: string; begin - //DebugLn(['TLinkScanner.IfCDirective FSkippingTillEndif=',FSkippingTillEndif]); + //DebugLn(['TLinkScanner.IfCDirective FSkippingDirectives=',ord(FSkippingDirectives),' IfLevel=',IfLevel]); inc(IfLevel); - inc(SrcPos); - Expr:=UpperCaseStr(copy(Src,SrcPos,CommentInnerEndPos-SrcPos)); - ResultStr:=Values.Eval(Expr); - Result:=true; - //DebugLn(['TLinkScanner.IfCDirective ResultStr=',ResultStr]); - if Values.ErrorPosition>=0 then begin - inc(SrcPos,Values.ErrorPosition); - RaiseException(ctsErrorInDirectiveExpression) - end else if ResultStr='0' then - SkipTillEndCifElse + Result:=InternalIfDirective; end; procedure TLinkScanner.SkipSpace; @@ -2221,7 +2223,7 @@ begin SkipSpace; VariableName:=ReadUpperIdentifier; if (VariableName<>'') and (Values.IsDefined(VariableName)) then - SkipTillEndifElse; + SkipTillEndifElse(lssdTillElse); Result:=true; end; @@ -2234,11 +2236,11 @@ function TLinkScanner.EndifDirective: boolean; end; begin + if IfLevel<=0 then + RaiseAWithoutB; dec(IfLevel); - if IfLevel<0 then - RaiseAWithoutB - else if IfLevel=0 then begin - inc(SrcPos,Values.ErrorPosition); - RaiseException(ctsErrorInDirectiveExpression) - end else if ResultStr='0' then - SkipTillEndifElse + Result:=InternalIfDirective; end; function TLinkScanner.IfOptDirective: boolean; @@ -2669,6 +2676,7 @@ function TLinkScanner.IfOptDirective: boolean; var Option, c: char; begin inc(IfLevel); + Result:=true; inc(SrcPos); Option:=UpChars[Src[SrcPos]]; if (IsWordChar[Option]) and (CompilerSwitchesNames[Option]<>'') @@ -2678,11 +2686,13 @@ begin c:=Src[SrcPos]; if c in ['+','-'] then begin if (c='-')<>(Values.Variables[CompilerSwitchesNames[Option]]='0') then - SkipTillEndifElse; + begin + SkipTillEndifElse(lssdTillElse); + exit; + end; end; end; end; - Result:=true; end; procedure TLinkScanner.SetIgnoreMissingIncludeFiles(const Value: boolean); @@ -2755,7 +2765,7 @@ end; function TLinkScanner.ReturnFromIncludeFile: boolean; var OldPos: TSourceLink; begin - if not FSkippingTillEndif then begin + if FSkippingDirectives=lssdNone then begin {$IFDEF ShowUpdateCleanedSrc} DebugLn('TLinkScanner.ReturnFromIncludeFile A UpdatePos=',DbgS(SrcPos-1)); {$ENDIF} @@ -2804,122 +2814,77 @@ begin Result:=true; end; -procedure TLinkScanner.SkipTillEndifElse; -var OldDirectiveFuncList: TKeyWordFunctionList; - c1: Char; -begin - SrcPos:=CommentEndPos; - {$IFDEF ShowUpdateCleanedSrc} - DebugLn('TLinkScanner.SkipTillEndifElse A UpdatePos=',DbgS(SrcPos-1)); - {$ENDIF} - UpdateCleanedSource(SrcPos-1); - OldDirectiveFuncList:=FDirectiveFuncList; - FDirectiveFuncList:=FSkipDirectiveFuncList; - try - // parse till $else, $elseif or $endif without adding the code to FCleanedSrc - FSkippingTillEndif:=true; - FSkipIfLevel:=IfLevel; - if (SrcPos<=SrcLen) then begin - while true do begin - c1:=Src[SrcPos]; - if IsCommentStartChar[c1] then begin - case c1 of - '{': begin - SkipComment; - if not FSkippingTillEndif then break; - end; - '/': if (Src[SrcPos+1]='/') then begin - SkipDelphiComment; - if not FSkippingTillEndif then break; - end else - inc(SrcPos); - '(': if (Src[SrcPos+1]='*') then begin - SkipOldTPComment; - if not FSkippingTillEndif then break; - end else - inc(SrcPos); - end; - end else if c1='''' then begin - // skip string constant - inc(SrcPos); - while (SrcPos<=SrcLen) and (Src[SrcPos]<>'''') do inc(SrcPos); - inc(SrcPos); - end else begin - inc(SrcPos); - if (SrcPos>SrcLen) and not ReturnFromIncludeFile then - break; - end; - end; - end; - LastCleanSrcPos:=CommentStartPos-1; - AddLink(CleanedLen+1,CommentStartPos,Code); - {$IFDEF ShowUpdateCleanedSrc} - DebugLn('TLinkScanner.SkipTillEndifElse B Continuing after: ', - '"',StringToPascalConst(copy(Src,LastCleanSrcPos+1,20)),'"'); - {$ENDIF} - finally - FDirectiveFuncList:=OldDirectiveFuncList; - FSkippingTillEndif:=false; - end; -end; +procedure TLinkScanner.SkipTillEndifElse(SkippingUntil: TLSSkippingDirective); -procedure TLinkScanner.SkipTillEndCifElse; -var OldDirectiveFuncList: TKeyWordFunctionList; + procedure RaiseAlreadySkipping; + begin + raise Exception.Create('TLinkScanner.SkipTillEndifElse inconsistency: already skipping ' + +' Old='+dbgs(ord(FSkippingDirectives)) + +' New='+dbgs(ord(SkippingUntil))); + end; + +var + OldDirectiveFuncList: TKeyWordFunctionList; c1: Char; begin + if FSkippingDirectives<>lssdNone then begin + FSkippingDirectives:=SkippingUntil; + exit; + end; + FSkippingDirectives:=SkippingUntil; + SrcPos:=CommentEndPos; {$IFDEF ShowUpdateCleanedSrc} - DebugLn('TLinkScanner.SkipTillEndCifElse A UpdatePos=',DbgS(SrcPos-1)); + DebugLn('TLinkScanner.SkipTillEndifElse A UpdatePos=',DbgS(SrcPos-1),' Src=',DbgStr(copy(Src,SrcPos-15,15))+'|'+DbgStr(copy(Src,SrcPos,15))); {$ENDIF} UpdateCleanedSource(SrcPos-1); + OldDirectiveFuncList:=FDirectiveFuncList; FDirectiveFuncList:=FSkipDirectiveFuncList; - try - // parse till $elsec, $elifc or $endc without adding the code to FCleanedSrc - FSkippingTillEndif:=true; - FSkipIfLevel:=IfLevel; - if (SrcPos<=SrcLen) then begin - while true do begin - c1:=Src[SrcPos]; - if IsCommentStartChar[c1] then begin - case c1 of - '{': begin - SkipComment; - if not FSkippingTillEndif then break; - end; - '/': if (Src[SrcPos+1]='/') then begin - SkipDelphiComment; - if not FSkippingTillEndif then break; - end else - inc(SrcPos); - '(': if (Src[SrcPos+1]='*') then begin - SkipOldTPComment; - if not FSkippingTillEndif then break; - end else - inc(SrcPos); - end; - end else if c1='''' then begin - // skip string constant - inc(SrcPos); - while (SrcPos<=SrcLen) and (Src[SrcPos]<>'''') do inc(SrcPos); - inc(SrcPos); - end else begin - inc(SrcPos); - if (SrcPos>SrcLen) and not ReturnFromIncludeFile then - break; + + // parse till $else, $elseif or $endif without adding the code to FCleanedSrc + FSkipIfLevel:=IfLevel; + if (SrcPos<=SrcLen) then begin + while true do begin + c1:=Src[SrcPos]; + if IsCommentStartChar[c1] then begin + case c1 of + '{': begin + SkipComment; + if FSkippingDirectives=lssdNone then break; + end; + '/': if (Src[SrcPos+1]='/') then begin + SkipDelphiComment; + if FSkippingDirectives=lssdNone then break; + end else + inc(SrcPos); + '(': if (Src[SrcPos+1]='*') then begin + SkipOldTPComment; + if FSkippingDirectives=lssdNone then break; + end else + inc(SrcPos); end; + end else if c1='''' then begin + // skip string constant + inc(SrcPos); + while (SrcPos<=SrcLen) and (Src[SrcPos]<>'''') do inc(SrcPos); + inc(SrcPos); + end else begin + inc(SrcPos); + if (SrcPos>SrcLen) and not ReturnFromIncludeFile then + break; end; end; - LastCleanSrcPos:=CommentStartPos-1; - AddLink(CleanedLen+1,CommentStartPos,Code); - {$IFDEF ShowUpdateCleanedSrc} - DebugLn('TLinkScanner.SkipTillEndifElse B Continuing after: ', - '"',StringToPascalConst(copy(Src,LastCleanSrcPos+1,20)),'"'); - {$ENDIF} - finally - FDirectiveFuncList:=OldDirectiveFuncList; - FSkippingTillEndif:=false; end; + LastCleanSrcPos:=CommentStartPos-1; + AddLink(CleanedLen+1,CommentStartPos,Code); + {$IFDEF ShowUpdateCleanedSrc} + DebugLn('TLinkScanner.SkipTillEndifElse B Continuing after: ', + ' Src=',DbgStr(copy(Src,CommentStartPos-15,15))+'|'+DbgStr(copy(Src,CommentStartPos,15))); + {$ENDIF} + + FDirectiveFuncList:=OldDirectiveFuncList; + FSkippingDirectives:=lssdNone; end; procedure TLinkScanner.SetCompilerMode(const AValue: TCompilerMode); @@ -2936,6 +2901,25 @@ begin Result:=true; end; +function TLinkScanner.InternalIfDirective: boolean; +// {$if expression} or {$ifc expression} or indirectly called by {$elifc expression} +var Expr, ResultStr: string; +begin + //DebugLn(['TLinkScanner.InternalIfDirective FSkippingDirectives=',ord(FSkippingDirectives),' IfLevel=',IfLevel]); + inc(SrcPos); + Expr:=UpperCaseStr(copy(Src,SrcPos,CommentInnerEndPos-SrcPos)); + ResultStr:=Values.Eval(Expr); + Result:=true; + //DebugLn(['TLinkScanner.InternalIfDirective ResultStr=',ResultStr]); + if Values.ErrorPosition>=0 then begin + inc(SrcPos,Values.ErrorPosition); + RaiseException(ctsErrorInDirectiveExpression) + end else if ResultStr='0' then + SkipTillEndifElse(lssdTillElse) + else + FSkippingDirectives:=lssdNone; +end; + function TLinkScanner.CursorToCleanPos(ACursorPos: integer; ACode: pointer; var ACleanPos: integer): integer; // 0=valid CleanPos