[fpc-pascal] run pascal programs as scripts

[michael.vancanneyt at wisa.be]

On Thu, 24 Mar 2011, Mattias Gaertner wrote:

> On Thu, 24 Mar 2011 23:10:08 +0100
> Felipe Monteiro de Carvalho <felipemonteiro.carvalho at gmail.com> wrote:
>
>>> Commenting is better. Then the reported error line numbers are still
>>> valid.
>>
>> Yes, but then bash won't recognize it, I suppose
>
> I meant:
>
> Original file:
> #!/usr/bin/instantfpc
> begin
> end.
>
> bash is happy.
>
>
> Preprocessor creates:
> //#!/usr/bin/instantfpc
> begin
> end.
>
> fpc is happy.

Indeed it works:

fsb: >cat testscript
#!/home/michael/fpcscript
program testscript;

Var
   I : Integer;

begin
  Write('Testscript called as ');
  For I:=0 to ParamCount do
    begin
    if I>0 then
      Write(' ');
    Write(paramstr(i));
    end;
   writeln;
end.
fsb: >./testscript
/usr/bin/ld: warning: link.res contains output sections; did you forget -T?
Testscript called as /tmp/fpc00000.tmp
fsb: >

And here is fpcscript (50 lines only):

$mode objfpc}{$h+}
program fpcscript;

uses sysutils,classes,baseunix, unix;

Const
   BufSize = 10 * 1024;
   Comment = '//';

Type
   TStringArray = Array of string;

Var
   F1,F2 : TFileStream;
   FN : String;
   Args : TStringArray;
   E,I : integer;

begin
   E:=127;
   F1:=TFileStream.Create(ParamStr(1),fmOpenRead);
   try
     FN:=GetTempFileName(GetTempDir,'fpc')+'.pp';
     F2:=TFileStream.Create(FN,fmCreate);
     try
       F2.WriteBuffer(Comment[1],Length(Comment));
       F2.CopyFrom(F1,F1.Size);
     finally
       F2.Free;
     end;
     if (ExecuteProcess('/usr/local/bin/fpc',[FN])=0) then
       begin
       If FileExists(ChangeFileExt(FN,'.o')) then
         DeleteFIle(ChangeFileExt(FN,'.o'));
       SetLength(Args,ParamCount-1);
       For I:=2 to ParamCount do
         Args[I-1]:=Paramstr(i);
       E:=ExecuteProcess(ChangeFileExt(FN,''),Args);
       If FileExists(ChangeFileExt(FN,'')) then
         DeleteFile(ChangeFileExt(FN,''));
       If FileExists(FN) then
         DeleteFile(Fn);
       end;
   Finally
     F1.Free;
   end;
   Halt(E); 
end.

Now we need to get rid of the ugly ld message and you're all set.

Michael.