paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-03 05:58:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: scanner will now give an error if a comment is not closed

Browse Source 
git-svn-id: trunk@1803 -
This commit is contained in:
lazarus 2002-07-31 11:43:38 +00:00
parent eda6857479
commit c4895bad37
4 changed files with 51 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/codetools/codetoolsstrconsts.pas
View File

@ -46,6 +46,7 @@ ResourceString
ctsIncludeFileNotFound = 'include file not found "%s"';
ctsErrorInDirectiveExpression = 'error in directive expression';
ctsIncludeCircleDetected = 'Include circle detected';
ctsCommentEndNotFound = 'Comment end not found';
// customcodetool
ctsIdentExpectedButAtomFound = 'identifier expected, but %s found';

1
components/codetools/keywordfunclists.pas
View File

@ -551,6 +551,7 @@ begin
Add('NEAR' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('DEPRECATED' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('PLATFORM' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('LOCAL' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('[' ,{$ifdef FPC}@{$endif}AllwaysTrue);
end;
IsKeyWordProcedureTypeSpecifier:=TKeyWordFunctionList.Create;

39
components/codetools/linkscanner.pas
View File

@ -171,6 +171,7 @@ type
procedure SkipComment;
procedure SkipDelphiComment;
procedure SkipOldTPComment;
procedure CommentEndNotFound;
procedure EndComment;
procedure IncCommentLevel;
procedure DecCommentLevel;
@ -842,7 +843,7 @@ begin
FSkippingTillEndif:=false;
if Assigned(FOnGetInitValues) then
FInitValues.Assign(FOnGetInitValues(FMainCode,FInitValuesChangeStep));
//writeln('TLinkScanner.Scan C --------');
//writeln('TLinkScanner.Scan D --------');
Values.Assign(FInitValues);
for cm:=Low(TCompilerMode) to High(TCompilerMode) do
if FInitValues.IsDefined(CompilerModeVars[cm]) then begin
@ -854,7 +855,7 @@ begin
PascalCompiler:=pc;
end;
//writeln(Values.AsString);
//writeln('TLinkScanner.Scan D --------');
//writeln('TLinkScanner.Scan E --------');
FMacrosOn:=(Values.Variables['MACROS']<>'0');
if Src='' then exit;
// beging scanning
@ -862,11 +863,11 @@ begin
AddLink(1,SrcPos,Code);
LastTokenType:=lsttNone;
{$IFDEF CTDEBUG}
writeln('TLinkScanner.Scan D ',SrcLen);
writeln('TLinkScanner.Scan F ',SrcLen);
{$ENDIF}
repeat
ReadNextToken;
//writeln('TLinkScanner.Scan E "',copy(Src,TokenStart,SrcPos-TokenStart),'"');
//writeln('TLinkScanner.Scan G "',copy(Src,TokenStart,SrcPos-TokenStart),'"');
UpdateCleanedSource(SrcPos-1);
if (SrcPos<=SrcLen+1) then begin
if (LastTokenType<>lsttEqual)
@ -902,7 +903,6 @@ begin
IncCommentLevel;
inc(SrcPos);
CommentInnerStartPos:=SrcPos;
if SrcPos>SrcLen then exit;
{ HandleSwitches can dec CommentLevel }
while (SrcPos<=SrcLen) and (CommentLevel>0) do begin
case Src[SrcPos] of
@ -913,6 +913,7 @@ begin
end;
CommentEndPos:=SrcPos;
CommentInnerEndPos:=SrcPos-1;
if (CommentLevel>0) then CommentEndNotFound;
{ handle compiler switches }
if Src[CommentInnerStartPos]='$' then HandleDirectives;
EndComment;
@ -926,9 +927,8 @@ begin
IncCommentLevel;
inc(SrcPos,2);
CommentInnerStartPos:=SrcPos;
if SrcPos>SrcLen then exit;
if (Src[SrcPos]='$') then ;
while (SrcPos<=SrcLen) and (Src[SrcPos]<>#10) do inc(SrcPos);
DecCommentLevel;
inc(SrcPos);
CommentEndPos:=SrcPos;
CommentInnerEndPos:=SrcPos-1;
@ -944,18 +944,30 @@ begin
IncCommentLevel;
inc(SrcPos,2);
CommentInnerStartPos:=SrcPos;
if SrcPos>SrcLen then exit;
// ToDo: nested comments
while (SrcPos<=SrcLen)
and ((Src[SrcPos-1]<>'*') or (Src[SrcPos]<>')')) do inc(SrcPos);
inc(SrcPos);
while (SrcPos<SrcLen) do begin
if ((Src[SrcPos]<>'*') or (Src[SrcPos+1]<>')')) then
inc(SrcPos)
else begin
DecCommentLevel;
inc(SrcPos,2);
break;
end;
end;
CommentEndPos:=SrcPos;
CommentInnerEndPos:=SrcPos-2;
if (CommentLevel>0) then CommentEndNotFound;
{ handle compiler switches }
if Src[CommentInnerStartPos]='$' then HandleDirectives;
EndComment;
end;
procedure TLinkScanner.CommentEndNotFound;
begin
SrcPos:=CommentStartPos;
RaiseException(ctsCommentEndNotFound);
end;
procedure TLinkScanner.UpdateCleanedSource(SourcePos: integer);
// add new parsed code to cleaned source string
var AddLen, i: integer;
@ -2184,6 +2196,11 @@ begin
else
inc(SrcPos);
end;
end else if Src[SrcPos]='''' 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 then ReturnFromIncludeFile;

25
lcl/lresources.pp
View File

@ -460,6 +460,23 @@ type
constructor Create(Stream: TStream);
procedure Write(const Buf; Count: Longint);
end;
{function Utf8Decode(const S: UTF8String): WideString;
var
L: Integer;
Temp: WideString;
begin
Result := '';
if S = '' then Exit;
SetLength(Temp, Length(S));
L := Utf8ToUnicode(PWideChar(Temp), Length(Temp)+1, PChar(S), Length(S));
if L > 0 then
SetLength(Temp, L-1)
else
Temp := '';
Result := Temp;
end;}
{ TDelphiReader }
@ -959,14 +976,14 @@ var
WriteStr('''');
while J < I do
begin
//ToDo: WriteStr(Char(W[J]));
WriteStr(Char(W[J]));
Inc(J);
end;
WriteStr('''');
end else
begin
WriteStr('#');
//ToDo: WriteStr(IntToStr(Ord(W[I])));
WriteStr(IntToStr(Ord(W[I])));
Inc(I);
if ((I - K) >= LineLength) then LineBreak := True;
end;
@ -1004,8 +1021,8 @@ var
((I - K) >= LineLength);
if ((I - K) >= LineLength) then
begin
LIneBreak := True;
//ToDo: if ByteType(S, I) = mbTrailByte then Dec(I);
LineBreak := True;
if ByteType(S, I) = mbTrailByte then Dec(I);
end;
WriteStr('''');
Writer.Write(S[J], I - J);