mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-07-30 11:26:45 +02:00
* New simple program to test if pparser parses some code
git-svn-id: trunk@35358 -
This commit is contained in:
parent
81a00358a1
commit
a809705fb8
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -2570,6 +2570,7 @@ packages/fcl-net/src/win/resolve.inc svneol=native#text/plain
|
||||
packages/fcl-passrc/Makefile svneol=native#text/plain
|
||||
packages/fcl-passrc/Makefile.fpc svneol=native#text/plain
|
||||
packages/fcl-passrc/Makefile.fpc.fpcmake svneol=native#text/plain
|
||||
packages/fcl-passrc/examples/parsepp.pp svneol=native#text/plain
|
||||
packages/fcl-passrc/examples/test_parser.pp svneol=native#text/plain
|
||||
packages/fcl-passrc/examples/testunit1.pp svneol=native#text/plain
|
||||
packages/fcl-passrc/fpmake.pp svneol=native#text/plain
|
||||
|
88
packages/fcl-passrc/examples/parsepp.pp
Normal file
88
packages/fcl-passrc/examples/parsepp.pp
Normal file
@ -0,0 +1,88 @@
|
||||
{ ---------------------------------------------------------------------
|
||||
This is a simple program to check whether fcl-passrc
|
||||
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
program parsepp;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses SysUtils, Classes, PParser, PasTree;
|
||||
|
||||
type
|
||||
{ We have to override abstract TPasTreeContainer methods.
|
||||
See utils/fpdoc/dglobals.pp for an implementation of TFPDocEngine,
|
||||
a "real" engine. }
|
||||
TSimpleEngine = class(TPasTreeContainer)
|
||||
public
|
||||
function CreateElement(AClass: TPTreeElement; const AName: String;
|
||||
AParent: TPasElement; AVisibility: TPasMemberVisibility;
|
||||
const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
|
||||
override;
|
||||
function FindElement(const AName: String): TPasElement; override;
|
||||
end;
|
||||
|
||||
function TSimpleEngine.CreateElement(AClass: TPTreeElement; const AName: String;
|
||||
AParent: TPasElement; AVisibility: TPasMemberVisibility;
|
||||
const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
|
||||
begin
|
||||
Result := AClass.Create(AName, AParent);
|
||||
Result.Visibility := AVisibility;
|
||||
Result.SourceFilename := ASourceFilename;
|
||||
Result.SourceLinenumber := ASourceLinenumber;
|
||||
end;
|
||||
|
||||
function TSimpleEngine.FindElement(const AName: String): TPasElement;
|
||||
begin
|
||||
{ dummy implementation, see TFPDocEngine.FindElement for a real example }
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
Procedure Usage;
|
||||
|
||||
begin
|
||||
Writeln('Usage : ',ExtractFileName(Paramstr(0)),' [-h|--help] options ');
|
||||
Writeln('-h or --help shows this help');
|
||||
Writeln('All other options are passed as-is to the parser');
|
||||
Halt(0);
|
||||
end;
|
||||
|
||||
var
|
||||
M: TPasModule;
|
||||
E: TPasTreeContainer;
|
||||
I: Integer;
|
||||
Decls: TFPList;
|
||||
cmdline : String;
|
||||
|
||||
begin
|
||||
cmdline:='';
|
||||
if (ParamCount=0) or (Paramstr(1)='-h') or (Paramstr(1)='--help') then
|
||||
Usage;
|
||||
For I:=1 to ParamCount do
|
||||
CmdLine:=CmdLine+' '+Paramstr(i);
|
||||
E := TSimpleEngine.Create;
|
||||
try
|
||||
M := ParseSource(E, cmdline, 'linux', 'i386');
|
||||
|
||||
{ Cool, we successfully parsed the module.
|
||||
Now output some info about it. }
|
||||
if M.InterfaceSection <> nil then
|
||||
begin
|
||||
Decls := M.InterfaceSection.Declarations;
|
||||
for I := 0 to Decls.Count - 1 do
|
||||
Writeln('Interface item ', I, ': ' +
|
||||
(TObject(Decls[I]) as TPasElement).Name);
|
||||
end else
|
||||
Writeln('No interface section --- this is not a unit, this is a ', M.ClassName);
|
||||
|
||||
if M.ImplementationSection <> nil then // may be nil in case of a simple program
|
||||
begin
|
||||
Decls := M.ImplementationSection.Declarations;
|
||||
for I := 0 to Decls.Count - 1 do
|
||||
Writeln('Implementation item ', I, ': ' +
|
||||
(TObject(Decls[I]) as TPasElement).Name);
|
||||
end;
|
||||
|
||||
FreeAndNil(M);
|
||||
finally FreeAndNil(E) end;
|
||||
end.
|
Loading…
Reference in New Issue
Block a user