From 337f29341634c32ad89c658dfbd9cf4cd3649ee1 Mon Sep 17 00:00:00 2001 From: mgaertner Date: Fri, 25 Mar 2011 17:53:45 +0000 Subject: [PATCH] instantfpc git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1535 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- applications/instantfpc/README.txt | 26 +++ applications/instantfpc/examples/envvars.pas | 13 ++ applications/instantfpc/examples/exitcode.pas | 13 ++ .../instantfpc/examples/helloworld.pas | 4 + applications/instantfpc/instantfpc.lpi | 77 +++++++ applications/instantfpc/instantfpc.lpr | 119 +++++++++++ applications/instantfpc/instantfptools.pas | 192 ++++++++++++++++++ .../orpheus/tests/TestTable/project1.lpi | 70 +++++-- 8 files changed, 498 insertions(+), 16 deletions(-) create mode 100644 applications/instantfpc/README.txt create mode 100755 applications/instantfpc/examples/envvars.pas create mode 100755 applications/instantfpc/examples/exitcode.pas create mode 100755 applications/instantfpc/examples/helloworld.pas create mode 100644 applications/instantfpc/instantfpc.lpi create mode 100644 applications/instantfpc/instantfpc.lpr create mode 100644 applications/instantfpc/instantfptools.pas diff --git a/applications/instantfpc/README.txt b/applications/instantfpc/README.txt new file mode 100644 index 000000000..ef740f39d --- /dev/null +++ b/applications/instantfpc/README.txt @@ -0,0 +1,26 @@ +instantfpc +========== + +This tool allows to execute pascal programs as unix scripts. +A unix script starts with a shebang #! and the program to execute. For example + +#!/usr/bin/env instantfpc +begin + writeln('It works'); +end. + +If you save the above file as test.pas and set the execute permission +(chmod a+x) you can execute the script simply with +./test.pas + + +Installation +============ + +1. Compile instantfpc.lpi using lazarus, lazbuild or via "fpc instantfpc.lpr" +2. Put the executable "instantfpc" in PATH, for example into + /usr/bin/instantfpc or ~/bin/instantfpc. + +That's all. +Now you can execute pascal programs as scripts. + diff --git a/applications/instantfpc/examples/envvars.pas b/applications/instantfpc/examples/envvars.pas new file mode 100755 index 000000000..4cacf1886 --- /dev/null +++ b/applications/instantfpc/examples/envvars.pas @@ -0,0 +1,13 @@ +#!/usr/bin/env instantfpc -Mobjfpc -Sh + +uses + SysUtils; +var + i: Integer; +begin + for i:=0 to Paramcount do + writeln('Param ',i,' ',ParamStr(i)); + for i:=0 to GetEnvironmentVariableCount-1 do + writeln('Env ',GetEnvironmentString(i)); +end. + diff --git a/applications/instantfpc/examples/exitcode.pas b/applications/instantfpc/examples/exitcode.pas new file mode 100755 index 000000000..a85bdf73d --- /dev/null +++ b/applications/instantfpc/examples/exitcode.pas @@ -0,0 +1,13 @@ +#!/usr/bin/env instantfpc + +{$mode objfpc}{$H+} + +uses SysUtils; + +var i: integer; +begin + i:=StrToInt(ParamStr(1)); + writeln('exit code: ',i); + Halt(i); +end. + diff --git a/applications/instantfpc/examples/helloworld.pas b/applications/instantfpc/examples/helloworld.pas new file mode 100755 index 000000000..5179b3416 --- /dev/null +++ b/applications/instantfpc/examples/helloworld.pas @@ -0,0 +1,4 @@ +#!/usr/bin/env instantfpc +begin + writeln('Hello world 2'); +end. diff --git a/applications/instantfpc/instantfpc.lpi b/applications/instantfpc/instantfpc.lpi new file mode 100644 index 000000000..82d22e028 --- /dev/null +++ b/applications/instantfpc/instantfpc.lpi @@ -0,0 +1,77 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/applications/instantfpc/instantfpc.lpr b/applications/instantfpc/instantfpc.lpr new file mode 100644 index 000000000..55b2801f4 --- /dev/null +++ b/applications/instantfpc/instantfpc.lpr @@ -0,0 +1,119 @@ +{ Compile and run a pascal program. + + Copyright (C) 2011 Mattias Gaertner mattias@freepascal.org + + This source is free software; you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free + Software Foundation; either version 2 of the License, or (at your option) + any later version. + + This code is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + details. + + A copy of the GNU General Public License is available on the World Wide Web + at . You can also obtain it by writing + to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, + MA 02111-1307, USA. +} +program instantfpc; + +{$mode objfpc}{$H+} + +uses + Classes, SysUtils, InstantFPTools; + +const + Version = '1.0'; + +var + i: Integer; + p: String; + Filename: String; + Src: TStringList; + CacheDir: String; + CacheFilename: String; + OutputFilename: String; + ExeExt: String; +begin + Filename:=''; + { For example: + /usr/bin/instantfpc -MObjFpc -Sh ./envvars.pas param1 + } + for i:=1 to Paramcount do begin + p:=ParamStr(i); + //writeln('Param: ',i,' ',p); + if p='' then + continue + else if p='-v' then begin + writeln('instantfpc '+Version); + Halt(1); + end + else if p='-h' then begin + writeln('instantfpc '+Version); + writeln; + writeln('instantfpc -h'); + writeln(' This help message.'); + writeln; + writeln('instantfpc -v'); + writeln(' Print version and exit.'); + writeln; + writeln('instantfpc [fpc compiler options] [program parameters]'); + writeln(' Compiles source and runs program.'); + writeln(' Source is compared with the cache. If cache is not valid then'); + writeln(' source is copied to cache with the shebang line commented and'); + writeln(' cached source is compiled.'); + writeln(' If compilation fails the fpc output is written to stdout and'); + writeln(' instantfpc exits with error code 1.'); + writeln(' If compilation was successful the program is executed.'); + writeln; + writeln('instantfpc --get-cache'); + writeln(' Prints cache directory to stdout.'); + writeln; + writeln('Normal usage is to add as first line "#!instantfpc" to a source'); + Halt(0); + end else if p='--get-cache' then begin + CacheDir:=GetCacheDir; + write(CacheDir); + Halt(0); + end else if (p[1]<>'-') then begin + // the first non flag parameter is the file name of the script + // followed by the parameters for the script + Filename:=p; + break; + end; + end; + if Filename='' then begin + writeln('missing source file'); + Halt(1); + end; + + CheckSourceName(Filename); + + Src:=TStringList.Create; + try + Src.LoadFromFile(Filename); + CommentShebang(Src); + CacheDir:=GetCacheDir; + + // check cache + CacheFilename:=CacheDir+ExtractFileName(Filename); + ExeExt:=''; + OutputFilename:=CacheDir+ChangeFileExt(ExtractFileName(Filename),ExeExt); + if not IsCacheValid(Src,CacheFilename,OutputFilename) then begin + // save source in cache to find out next time if something changed + Src.SaveToFile(CacheFilename); + Compile(CacheFilename,OutputFilename); + end; + // run + Run(OutputFilename); + finally + // memory is freed by OS, but for debugging puposes you can do it manually + {$IFDEF IFFreeMem} + Proc.Free; + Src.Free; + {$ENDIF} + end; +end. + diff --git a/applications/instantfpc/instantfptools.pas b/applications/instantfpc/instantfptools.pas new file mode 100644 index 000000000..478ad19fe --- /dev/null +++ b/applications/instantfpc/instantfptools.pas @@ -0,0 +1,192 @@ +unit InstantFPTools; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Process, unix; + +procedure CheckSourceName(const Filename: string); +procedure CommentShebang(Src: TStringList); +function GetCacheDir: string; +function IsCacheValid(Src: TStringList; + const CachedSrcFile, CachedExeFile: string): boolean; +procedure Compile(const CacheFilename, OutputFilename: string); +function GetCompiler: string; +function GetCompilerParameters(const SrcFilename, OutputFilename: string): string; +procedure Run(const Filename: string); + +implementation + +procedure AddParam(p: string; var Line: string); +begin + if p='' then exit; + if Line<>'' then Line:=Line+' '; + if (p[1]<>'"') and (System.Pos(' ',p)>0) then + p:='"'+p+'"'; + Line:=Line+p; +end; + +procedure CheckSourceName(const Filename: string); +var + Ext: String; +begin + // avoid name clashes + Ext:=lowercase(ExtractFileExt(Filename)); + if (Ext<>'') and (Ext<>'.pas') and (Ext<>'.pp') and (Ext<>'.p') + and (Ext<>'.lpr') and (Ext<>'.txt') and (Ext<>'.sh') + then begin + writeln('invalid source extension ',Ext); + Halt(1); + end; +end; + +procedure CommentShebang(Src: TStringList); +var + Line: string; + i: Integer; +begin + // comment shebang #! + if (Src.Count=0) then exit; + Line:=Src[0]; + i:=1; + if copy(Line,1,3)=#$EF#$BB#$BF then + inc(i,3);// UTF8 BOM + if (i>length(Line)) or (Line[i]<>'#') then exit; + Src[0]:=copy(Line,1,i-1)+'//'+copy(Line,i,length(Line)); +end; + +function GetCacheDir: string; +begin + Result:=GetEnvironmentVariable('INSTANTFPCCACHE'); + if Result='' then begin + Result:=GetEnvironmentVariable('HOME'); + if Result<>'' then + Result:=IncludeTrailingPathDelimiter(Result)+'.cache'+PathDelim+'instantfpc'; + end; + if Result='' then begin + writeln('missing environment variable: HOME or INSTANTFPCCACHE'); + Halt(1); + end; + Result:=IncludeTrailingPathDelimiter(ExpandFileName(Result)); + if not ForceDirectories(Result) then begin + writeln('unable to create cache directory "'+Result+'"'); + Halt(1); + end; +end; + +function IsCacheValid(Src: TStringList; const CachedSrcFile, + CachedExeFile: string): boolean; +var + OldSrc: TStringList; +begin + Result:=false; + if not FileExists(CachedSrcFile) then exit; + if not FileExists(CachedExeFile) then exit; + OldSrc:=TStringList.Create; + OldSrc.LoadFromFile(CachedSrcFile); + Result:=Src.Equals(OldSrc); + {$IFDEF IFFreeMem} + OldSrc.Free; + {$ENDIF} +end; + +function GetCompiler: string; +var + Path: String; + p: Integer; + StartPos: LongInt; + Dir: String; + CompFile: String; +begin + {$IFDEF Windows} + CompFile:='fpc.exe'; + {$ELSE} + CompFile:='fpc'; + {$ENDIF} + Path:=GetEnvironmentVariable('PATH'); + if PATH<>'' then begin + p:=1; + while p<=length(Path) do begin + StartPos:=p; + while (p<=length(Path)) and (Path[p]<>':') do inc(p); + if StartPos

0) then begin + write(ss.DataString); + Halt(1); + end; + ss.Free; + Proc.Free; +end; + +function GetCompilerParameters(const SrcFilename, OutputFilename: string): string; +{ For example: + /usr/bin/instantfpc -MObjFpc -Sh ./envvars.pas param1 + The shebang compile parameters: -MObjFpc -Sh +} +var + p: String; +begin + Result:=''; + if (Paramcount>0) then begin + p:=ParamStr(1); + if (p<>'') and (p[1]='-') then + Result:=p; // copy compile params from the script + end; + AddParam('-o'+OutputFilename,Result); + AddParam(SrcFilename,Result); +end; + +procedure Run(const Filename: string); +var + p: PPChar; +begin + p:=argv; + inc(p); + while (p<>nil) do begin + if (p^<>nil) and (p^^<>'-') then begin + break; + end; + inc(p); + end; + Halt(FpExecV(Filename,p)); +end; + +end. + diff --git a/components/orpheus/tests/TestTable/project1.lpi b/components/orpheus/tests/TestTable/project1.lpi index fc9c97397..d18899551 100644 --- a/components/orpheus/tests/TestTable/project1.lpi +++ b/components/orpheus/tests/TestTable/project1.lpi @@ -1,19 +1,23 @@ + - + + + - - - + - + + + + @@ -23,7 +27,7 @@ - + @@ -34,43 +38,77 @@ - + - - + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + - + - + - + - +