From 9bfda53b7c9a520e50df2a0429c968d59a38d2bc Mon Sep 17 00:00:00 2001 From: mgaertner Date: Thu, 28 Jul 2011 06:49:32 +0000 Subject: [PATCH] instantfpc: readded for 2.4.4 users git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1763 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- applications/instantfpc/README.txt | 34 +++ applications/instantfpc/instantfpc.lpi | 77 ++++++ applications/instantfpc/instantfpc.pas | 187 ++++++++++++++ applications/instantfpc/instantfptools.pas | 271 +++++++++++++++++++++ 4 files changed, 569 insertions(+) create mode 100644 applications/instantfpc/instantfpc.lpi create mode 100644 applications/instantfpc/instantfpc.pas create mode 100644 applications/instantfpc/instantfptools.pas diff --git a/applications/instantfpc/README.txt b/applications/instantfpc/README.txt index a3ac56923..f8dd8341c 100644 --- a/applications/instantfpc/README.txt +++ b/applications/instantfpc/README.txt @@ -1,5 +1,39 @@ +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.pas" +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. + + +More information +============== + Instantfpc is now part of fpc 2.5.1. See here for more information: http://wiki.freepascal.org/InstantFPC + + + + diff --git a/applications/instantfpc/instantfpc.lpi b/applications/instantfpc/instantfpc.lpi new file mode 100644 index 000000000..8019f09ab --- /dev/null +++ b/applications/instantfpc/instantfpc.lpi @@ -0,0 +1,77 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/applications/instantfpc/instantfpc.pas b/applications/instantfpc/instantfpc.pas new file mode 100644 index 000000000..36c3ec401 --- /dev/null +++ b/applications/instantfpc/instantfpc.pas @@ -0,0 +1,187 @@ +{ 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'; + + +Procedure Usage; + +begin + writeln('instantfpc '+Version); + writeln; + writeln('instantfpc -h'); + writeln(' This help message.'); + writeln; + writeln('instantfpc -v'); + writeln(' Print version and exit.'); + writeln; + writeln('instantfpc [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(' If the compiler options contains -B the program is always'); + writeln(' compiled.'); + writeln; + writeln('instantfpc --get-cache'); + writeln(' Prints cache directory to stdout.'); + writeln; + writeln('instantfpc --set-cache='); + writeln(' Set the cache to be used.'); + writeln; + writeln('instantfpc --compiler='); + writeln(' Normally fpc is searched in PATH and used as compiler.'); + writeln; + writeln('Normal usage is to add as first line ("shebang") "#!/usr/bin/instantfpc"'); + writeln('to a program source file. Then you can execute the source like a script.'); + Halt(0); +end; + +Procedure DisplayCache; + +begin + write(GetCacheDir); + Halt(0); +end ; + +var + i,j: Integer; + p: String; + Filename: String; + Src: TStringList; + CacheDir: String; + CacheFilename: String; + OutputFilename: String; + ExeExt: String; + E : String; + +// Return true if filename found. + +Function InterpretParam(p : String) : boolean; + +begin + Result:=False; + if (P='') then exit; + if p='-v' then + begin + writeln('instantfpc '+Version); + Halt(1); + end + else if p='-h' then + usage + else if p='--get-cache' then + DisplayCache + else if copy(p,1,11)='--compiler=' then + begin + delete(P,1,11); + SetCompiler(p); + end + else if copy(p,1,12)='--set-cache=' then + begin + delete(P,1,12); + SetCacheDir(p); + end + else if (P<>'') and (p[1]<>'-') then + begin + Filename:=p; + Result:=True; + end; +end; + +begin + Filename:=''; + { For example: + /usr/bin/instantfpc -MObjFpc -Sh ./envvars.pas param1 + } + for i:=1 to Paramcount do + begin + p:=ParamStr(i); + if p='' then + continue + else + begin + if (I<>1) then + begin + if InterpretParam(p) then + Break; + end + else + begin + // The linux kernel passes the whole shebang line as 1 argument. + // We must parse and split it ourselves. + Repeat + J:=Pos(' ',P); + if (J=0) then + J:=Length(P)+1; + if InterpretParam(Copy(P,1,J-1)) then + Break; + Delete(P,1,J); + Until (P=''); + if (FileName<>'') then + Break; + end; + 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); + E:=LowerCase(ExtractFileExt(CacheFileName)); + if (E<>'.pp') and (E<>'.pas') and (E<>'.lpr') then + CacheFileName:=CacheFileName+'.pas'; + 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..397078487 --- /dev/null +++ b/applications/instantfpc/instantfptools.pas @@ -0,0 +1,271 @@ +unit InstantFPTools; + +{$mode objfpc}{$H+} + +{$define UseFpExecV} + +{$ifdef WINDOWS} + {$undef UseFpExecV} + {$define HASEXEEXT} +{$endif WINDOWS} +{$ifdef go32v2} + {$undef UseFpExecV} + {$define HASEXEEXT} +{$endif go32v2} + +interface + +uses + {$IFDEF UseFpExecV} + Unix, + {$ENDIF} + Classes, SysUtils, Process; + +procedure CheckSourceName(const Filename: string); +procedure CommentShebang(Src: TStringList); +function GetCacheDir: string; +procedure SetCacheDir(AValue : string); +function IsCacheValid(Src: TStringList; + const CachedSrcFile, CachedExeFile: string): boolean; +procedure Compile(const CacheFilename, OutputFilename: string); +function GetCompiler: string; +procedure SetCompiler(AValue : string); +function GetCompilerParameters(const SrcFilename, OutputFilename: string): string; +procedure Run(const Filename: string); + +implementation + +Var + CmdCacheDir : String; + CmdCompiler : String; + +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') and (Ext<>'.cgi') + 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; + + +procedure SetCacheDir(AValue : string); + +begin + CmdCacheDir:=AValue; +end; + +function GetCacheDir: string; +begin + Result:=CmdCacheDir; + if (Result='') then + begin + Result:=GetEnvironmentVariable('INSTANTFPCCACHE'); + if Result='' then + begin + Result:=GetEnvironmentVariable('HOME'); + if Result<>'' then + Result:=IncludeTrailingPathDelimiter(Result)+'.cache'+PathDelim+'instantfpc'; + end; + 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; + i: Integer; + p: String; +begin + Result:=false; + for i:=1 to Paramcount do begin + p:=ParamStr(i); + if (p='') or (p[1]<>'-') then break; + if p='-B' then exit; // always compile + end; + 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; + +procedure SetCompiler(AValue : string); + +begin + CmdCompiler:=AValue; +end; + +function GetCompiler: string; + +var + Path: String; + p: Integer; + StartPos: LongInt; + Dir: String; + CompFile: String; + +begin + Result:=CmdCompiler; + if (Result<>'') then + begin + Result:=ExpandFileName(Result); + if not FileExists(Result) then + begin + writeln('Error: '+Result+' not found, check the --compiler parameter.'); + Halt(1); + end; + exit; + end; + + {$IFDEF Windows} + CompFile:='fpc.exe'; + {$ELSE} + CompFile:='fpc'; + {$ENDIF} + Path:=GetEnvironmentVariable('PATH'); + {$IFDEF VER2_4} + 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 + ss.write(buf,count); + until Count=0; + if (not Proc.WaitOnExit) or (Proc.ExitStatus<>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; + i : integer; +begin + Result:=''; + I:=1; + While (I<=ParamCount) and (Copy(ParamStr(i),1,1)='-') do + begin + p:=ParamStr(i); + if (Copy(p,1,1)='-') and (copy(p,1,2)<>'--') then + AddParam(P,Result); + inc(I); + end; + AddParam('-o'+OutputFilename {$IFDEF HASEXEEXT} + '.exe' {$ENDIF},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; + {$IFNDEF UseFpExecV} + Inc(p); //lose the first command-line argument with the the script filename + Halt(ExecuteProcess(Filename,[p^])); + {$ELSE} + Halt(FpExecV(Filename,p)); + {$ENDIF} +end; + +end. +