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

codetools: replace macro functions with simple values

Browse Source 
git-svn-id: trunk@29838 -
This commit is contained in:
mattias 2011-03-14 12:54:58 +00:00
parent b2fbbd9b34
commit 0e03652260
4 changed files with 158 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
components/codetools/ccodeparsertool.pas
View File

@ -523,60 +523,110 @@ var
StrStream: TStringStream;
procedure Append(Code: TCodeBuffer; FromPos, EndPos: integer);
procedure Error(p: integer; const Msg: string);
var
Line: integer;
Column: integer;
s: String;
begin
Code.AbsoluteToLineCol(p,Line,Column);
s:=Code.Filename+'('+IntToStr(Line)+','+IntToStr(Column)+') Error: '+Msg;
raise Exception.Create(s);
end;
var
StartP: PChar;
AtomStart: integer;
p: LongInt;
MacroName: String;
MacroValue: string;
MacroNode: TAVLTreeNode;
MacroItem: PStringToStringTreeItem;
Src: String;
BracketLvl: Integer;
begin
if FromPos<1 then FromPos:=1;
if EndPos>Code.SourceLength then EndPos:=Code.SourceLength+1;
if (EndPos<=FromPos) or (FromPos>Code.SourceLength) then exit;
p:=FromPos;
Src:=Code.Source;
while p<EndPos do begin
ReadRawNextCAtom(Code.Source,p,AtomStart);
ReadRawNextCAtom(Src,p,AtomStart);
if AtomStart>=EndPos then break;
StartP:=@Code.Source[AtomStart];
StartP:=@Src[AtomStart];
if (StartP^='#') and IsFirstNonSpaceCharInLine(Code.Source,AtomStart) then
begin
// directive
ReadRawNextCAtom(Code.Source,p,AtomStart);
ReadRawNextCAtom(Src,p,AtomStart);
if AtomStart>=EndPos then break;
StartP:=@Code.Source[AtomStart];
StartP:=@Src[AtomStart];
if (CompareIdentifiersCaseSensitive(StartP,'define')=0)
or (CompareIdentifiersCaseSensitive(StartP,'undef')=0)
or (CompareIdentifiersCaseSensitive(StartP,'ifdef')=0)
or (CompareIdentifiersCaseSensitive(StartP,'ifndef')=0)
then begin
// a ifdef/ifndef/define/undefine directive
// the next identifier should not be replaced as macro
ReadRawNextCAtom(Code.Source,p,AtomStart);
// the next identifier must not be replaced as macro
ReadRawNextCAtom(Src,p,AtomStart);
if AtomStart>=EndPos then break;
end;
end
else if IsIdentStartChar[StartP^] and Macros.ContainsIdentifier(StartP)
then begin
// macro found
MacroName:=GetIdentifier(StartP);
MacroValue:=Macros[MacroName];
//debugln(['Append Macro found: ',MacroName]);
// write source in front of macro
if AtomStart>FromPos then begin
AddLink(StrStream.Position+1,Code,FromPos);
StrStream.Write(Code.Source[FromPos],AtomStart-FromPos);
end;
FromPos:=p;
if MacroValue<>'' then begin
// write macro value
AddLink(StrStream.Position+1,nil,0);
StrStream.Write(MacroValue[1],length(MacroValue));
else if IsIdentStartChar[StartP^] then begin
MacroNode:=Macros.FindNodeWithIdentifierAsPrefix(StartP);
if MacroNode<>nil then begin
// macro found
MacroItem:=PStringToStringTreeItem(MacroNode.Data);
debugln(['Append MacroName=',MacroItem^.Name,' ',GetIdentifier(@Src[AtomStart])]);
// write source in front of macro
if AtomStart>FromPos then begin
AddLink(StrStream.Position+1,Code,FromPos);
StrStream.Write(Code.Source[FromPos],AtomStart-FromPos);
FromPos:=p;
end;
if System.Pos('(',MacroItem^.Name)>0
then begin
// a macro function
// => read parameters
ReadRawNextCAtom(Src,p,AtomStart);
if AtomStart>=EndPos then begin
Error(p+GetIdentLen(@Src[FromPos]),
'missing ( after macro function "'+GetIdentifier(@Src[FromPos])+'"');
end;
if Src[AtomStart]<>'(' then begin
Error(AtomStart,'expected ( after macro function "'+GetIdentifier(@Src[FromPos])+'"'
+' but found "'+copy(Src,AtomStart,p-AtomStart)+'"');
end;
BracketLvl:=1;
repeat
ReadRawNextCAtom(Src,p,AtomStart);
if AtomStart>=EndPos then begin
Error(p+GetIdentLen(@Src[FromPos]),
'missing ) for macro function "'+GetIdentifier(@Src[FromPos])+'"');
end;
case Src[AtomStart] of
'(': inc(BracketLvl);
')':
begin
dec(BracketLvl);
if BracketLvl=0 then break;
end;
end;
until false;
FromPos:=p;
end;
MacroValue:=MacroItem^.Value;
//debugln(['Append Macro found: ',MacroItem^.Name]);
if MacroValue<>'' then begin
// write macro value
AddLink(StrStream.Position+1,nil,0);
StrStream.Write(MacroValue[1],length(MacroValue));
end;
end;
end;
end;
if FromPos<EndPos then begin
AddLink(StrStream.Position+1,Code,FromPos);
StrStream.Write(Code.Source[FromPos],EndPos-FromPos);
StrStream.Write(Src[FromPos],EndPos-FromPos);
end;
end;
@ -597,6 +647,7 @@ var
IncFilename: String;
MergePos: Integer;
begin
if MergedBuffers.IndexOf(Code)>=0 then exit;
MergedBuffers.Add(Code);
MergePos:=1;
if not (chfmfIgnoreIncludes in Flags) then begin

40
components/codetools/codetoolsstructs.pas
View File

@ -121,6 +121,7 @@ type
procedure Clear;
function Contains(const s: string): boolean;
function ContainsIdentifier(P: PChar): boolean;
function FindNodeWithIdentifierAsPrefix(P: PChar): TAVLTreeNode;
function GetString(const Name: string; out Value: string): boolean;
procedure Add(const Name, Value: string);
procedure GetNames(List: TStrings);
@ -181,11 +182,13 @@ type
function CompareStringToStringItems(Data1, Data2: Pointer): integer;
function CompareStringAndStringToStringTreeItem(Key, Data: Pointer): integer;
function CompareIdentifierAndStringToStringTreeItem(Identifier, Data: Pointer): integer;
function CompareIdentifierPrefixAndStringToStringTreeItem(Identifier, Data: Pointer): integer;
// case insensitive
function CompareStringToStringItemsI(Data1, Data2: Pointer): integer;
function CompareStringAndStringToStringTreeItemI(Key, Data: Pointer): integer;
function CompareIdentifierAndStringToStringTreeItemI(Identifier, Data: Pointer): integer;
function CompareIdentifierPrefixAndStringToStringTreeItemI(Identifier, Data: Pointer): integer;
function CompareFilenameToStringItems(Data1, Data2: Pointer): integer;
function CompareFilenameAndFilenameToStringTreeItem(Key, Data: Pointer): integer;
@ -224,13 +227,14 @@ function CompareIdentifierAndStringToStringTreeItem(Identifier, Data: Pointer
): integer;
var
Id: PChar absolute Identifier;
Item: PStringToStringTreeItem absolute Data;
IdLen: LongInt;
ItemLen: PtrInt;
begin
Result:=-CompareIdentifiersCaseSensitive(PChar(Id),PChar(PStringToStringTreeItem(Data)^.Name));
Result:=-CompareIdentifiersCaseSensitive(Id,PChar(Item^.Name));
if Result=0 then begin
IdLen:=GetIdentLen(Id);
ItemLen:=length(PStringToStringTreeItem(Data)^.Name);
ItemLen:=length(Item^.Name);
if IdLen=Itemlen then
Result:=0
else if IdLen>ItemLen then
@ -240,6 +244,15 @@ begin
end;
end;
function CompareIdentifierPrefixAndStringToStringTreeItem(Identifier,
Data: Pointer): integer;
var
Id: PChar absolute Identifier;
Item: PStringToStringTreeItem absolute Data;
begin
Result:=-CompareIdentifiersCaseSensitive(Id,PChar(Item^.Name));
end;
function CompareStringAndStringToStringTreeItemI(Key, Data: Pointer): integer;
begin
Result:=CompareText(String(Key),PStringToStringTreeItem(Data)^.Name);
@ -249,13 +262,14 @@ function CompareIdentifierAndStringToStringTreeItemI(Identifier, Data: Pointer
): integer;
var
Id: PChar absolute Identifier;
Item: PStringToStringTreeItem absolute Data;
IdLen: LongInt;
ItemLen: PtrInt;
begin
Result:=-CompareIdentifiers(PChar(Id),PChar(PStringToStringTreeItem(Data)^.Name));
Result:=-CompareIdentifiers(Id,PChar(Item^.Name));
if Result=0 then begin
IdLen:=GetIdentLen(Id);
ItemLen:=length(PStringToStringTreeItem(Data)^.Name);
ItemLen:=length(Item^.Name);
if IdLen=Itemlen then
Result:=0
else if IdLen>ItemLen then
@ -265,6 +279,15 @@ begin
end;
end;
function CompareIdentifierPrefixAndStringToStringTreeItemI(Identifier,
Data: Pointer): integer;
var
Id: PChar absolute Identifier;
Item: PStringToStringTreeItem absolute Data;
begin
Result:=-CompareIdentifiers(Id,PChar(Item^.Name));
end;
function CompareFilenameAndFilenameToStringTreeItem(Key, Data: Pointer
): integer;
begin
@ -535,6 +558,15 @@ begin
Result:=FTree.FindKey(p,@CompareIdentifierAndStringToStringTreeItemI)<>nil;
end;
function TStringToStringTree.FindNodeWithIdentifierAsPrefix(P: PChar
): TAVLTreeNode;
begin
if CaseSensitive then
Result:=FTree.FindKey(p,@CompareIdentifierPrefixAndStringToStringTreeItem)
else
Result:=FTree.FindKey(p,@CompareIdentifierPrefixAndStringToStringTreeItemI);
end;
function TStringToStringTree.GetString(const Name: string; out Value: string
): boolean;
var

10
components/codetools/examples/convert_glib3.sh
View File

@ -1,13 +1,18 @@
#!/bin/bash
# do not include gerror.h - it only contains c macros for debugging
# do not include gslice.h, gmem.h - it only contains c macros for fast mem allocation
# do not include gslice.h, gmem.h - they only contain c macros for optimization
# do not include gtestutils.h - it only contains the test suite
dir=~/cpp/gtk3/glib/glib
./h2pastest -uG_BEGIN_DECLS -uG_END_DECLS -uG_GNUC_CONST -dG_CONST_RETURN=const \
-uGLIB_VAR -uG_INLINE_FUNC -uG_GNUC_MAY_ALIAS -uG_GNUC_MALLOC \
-uG_GNUC_WARN_UNUSED_RESULT -uG_GNUC_NULL_TERMINATED \
-uG_GNUC_PURE \
-uG_GNUC_PURE -dG_GNUC_PRINTF"()" \
-uGLIB_SYSDEF_POLLIN -uGLIB_SYSDEF_POLLOUT -uGLIB_SYSDEF_POLLPRI \
-uGLIB_SYSDEF_POLLERR -uGLIB_SYSDEF_POLLHUP -uGLIB_SYSDEF_POLLNVAL \
-uG_GNUC_INTERNAL -uG_GNUC_NORETURN \
-dG_GNUC_ALLOC_SIZE"()" -dG_GNUC_FORMAT"()" \
$dir/glib.h \
$dir/galloca.h \
$dir/garray.h \
@ -70,7 +75,6 @@ dir=~/cpp/gtk3/glib/glib
$dir/gstdio.h \
$dir/gstrfuncs.h \
$dir/gstring.h \
$dir/gtestutils.h \
$dir/gthread.h \
$dir/gthreadpool.h \
$dir/gthreadprivate.h \

46
components/codetools/examples/h2pastest.lpr
View File

@ -54,6 +54,7 @@ var
MacroName: String;
p: LongInt;
MacroValue: String;
MacroFuncName: String;
begin
Merger:=nil;
try
@ -73,12 +74,32 @@ begin
MacroName:=copy(MacroName,1,p-1);
end;
MacroName:=copy(MacroName,1,255);
if not IsValidIdent(MacroName) then begin
writeln('invalid macro name "',MacroName,'"');
Halt;
end;
Merger.Macros[MacroName]:=MacroValue;
Tool.Defines.Add(MacroName,MacroValue);
p:=System.Pos('(',MacroName);
if p<1 then begin
// macro (not macro function)
if not IsValidIdent(MacroName) then begin
writeln('invalid macro name "',MacroName,'"');
Halt;
end;
Merger.Macros[MacroName]:=MacroValue;
Tool.Defines.Add(MacroName,MacroValue);
end else begin
// maybe a macro function
MacroFuncName:=copy(MacroName,1,p-1);
if not IsValidIdent(MacroFuncName) then begin
writeln('invalid macro name "',MacroFuncName,'"');
Halt;
end;
if p=length(MacroName) then begin
writeln('invalid macro function "',MacroName,'"');
Halt;
end;
if MacroName[p+1]<>')' then begin
writeln('macro function "',MacroName,'": parameters are not supported yet');
Halt;
end;
Merger.Macros[MacroName]:=MacroValue;
end
end
else if copy(Param,1,2)='-u' then begin
MacroName:=copy(Param,3,255);
@ -100,6 +121,19 @@ begin
writeln('');
writeln(' --merge-all');
writeln(' Merge all given files. Normally only files needed by the main header files are merged.');
writeln(' -u<name>');
writeln(' Undefines a macro. "#idfef name" will give false.');
writeln(' -d<name>');
writeln(' Defines a macro with an empty value. "#idfef name" will give true.');
writeln(' -d<name>=<value>');
writeln(' Defines a macro with a value. Value is not replaced recursively.');
writeln(' -d"<name>()"=<value>');
writeln(' Defines a macro function with a value. Value is not replaced recursively.');
writeln(' The function fits any number of parameters.');
writeln('');
writeln('For example:');
writeln(' ',ParamStr(0),' -dEnableFlag -dFlag2=Value -uUndefineMacro test.h header2.h');
writeln(' ',ParamStr(0),' -d"printf()" test.h');
Halt;
end else begin
Filename:=CleanAndExpandFilename(Param);