Browse Source

* New simple program to test if pparser parses some code

git-svn-id: trunk@35358 -
michael 8 years ago
parent
commit
a809705fb8
2 changed files with 89 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 88 0
      packages/fcl-passrc/examples/parsepp.pp

+ 1 - 0
.gitattributes

@@ -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 svneol=native#text/plain
 packages/fcl-passrc/Makefile.fpc 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/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/test_parser.pp svneol=native#text/plain
 packages/fcl-passrc/examples/testunit1.pp svneol=native#text/plain
 packages/fcl-passrc/examples/testunit1.pp svneol=native#text/plain
 packages/fcl-passrc/fpmake.pp svneol=native#text/plain
 packages/fcl-passrc/fpmake.pp svneol=native#text/plain

+ 88 - 0
packages/fcl-passrc/examples/parsepp.pp

@@ -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.