Changeset 162


Ignore:
Timestamp:
Aug 20, 2024, 12:23:10 AM (3 months ago)
Author:
chronos
Message:

Merged revision(s) 161 from trunk:

  • Fixed: All targets compilation and run.
Location:
tags/1.3.0
Files:
14 edited
2 copied

Legend:

Unmodified
Added
Removed

  • tags/1.3.0

  • tags/1.3.0/Core.lfm

    r160 r162  
    2121    AppName = 'LazFuck'
    2222    Description = 'A simple BrainFuck IDE written in Lazarus/FPC.'
    23     ReleaseDate = 45523
     23    ReleaseDate = 45082
    2424    RegistryKey = '\Software\Chronosoft\LazFuck'
    2525    RegistryRoot = rrKeyCurrentUser

  • tags/1.3.0/Core.pas

    r157 r162  
    101101  // If installed in Linux system then use installation shared game directory for data files
    102102  if DirectoryExists(LinuxDataDir) then
    103     DataDir := LinuxDataDir;
     103    DataDir := LinuxDataDir
     104    else DataDir := GetCurrentDir;
    104105  // If installed in Linux system then use installation directory for po files
    105106  if not DirectoryExists(Translator.POFilesFolder) and DirectoryExists(LinuxLanguagesDir) then

  • tags/1.3.0/Packages/Common/Common.pas

    r153 r162  
    5555function EndsWith(Text, What: string): Boolean;
    5656function Explode(Separator: Char; Data: string): TStringArray;
    57 procedure ExecuteProgram(Executable: string; Parameters: array of string);
     57procedure ExecuteProgram(Executable: string; Parameters: array of string;
     58  Environment: array of string; CurrentDirectory: string = '');
     59procedure ExecuteProgramOutput(Executable: string; Parameters: array of string;
     60  Environment: array of string; out Output, Error: string;
     61  out ExitCode: Integer; CurrentDirectory: string = '');
    5862procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog);
    5963procedure FreeThenNil(var Obj);
    … …  
    6367function GetBit(Variable: QWord; Index: Byte): Boolean;
    6468function GetStringPart(var Text: string; Separator: string): string;
     69function GetEnvironmentVariables: TStringArray;
    6570function GenerateNewName(OldName: string): string;
    6671function GetFileFilterItemExt(Filter: string; Index: Integer): string;
    6772function IntToBin(Data: Int64; Count: Byte): string;
    68 function Implode(Separator: string; List: TList<string>): string;
    69 function Implode(Separator: string; List: TStringList; Around: string = ''): string;
     73function Implode(Separator: string; List: TList<string>): string; overload;
     74function Implode(Separator: string; List: array of string): string; overload;
     75function Implode(Separator: string; List: TStringList; Around: string = ''): string; overload;
    7076function LastPos(const SubStr: String; const S: String): Integer;
    7177function LoadFileToStr(const FileName: TFileName): AnsiString;
    … …  
    98104implementation
    99105
     106resourcestring
     107  SExecutionError = 'Excution error: %s (exit code: %d)';
     108
    100109function StartsWith(Text, What: string): Boolean;
    101110begin
    … …  
    108117end;
    109118
    110 function BinToInt(BinStr : string) : Int64;
    111 var
    112   i : byte;
    113   RetVar : Int64;
     119function BinToInt(BinStr: string): Int64;
     120var
     121  I: Byte;
     122  RetVar: Int64;
    114123begin
    115124  BinStr := UpperCase(BinStr);
    116   if BinStr[length(BinStr)] = 'B' then Delete(BinStr,length(BinStr),1);
     125  if BinStr[length(BinStr)] = 'B' then Delete(BinStr, Length(BinStr), 1);
    117126  RetVar := 0;
    118   for i := 1 to length(BinStr) do begin
    119     if not (BinStr[i] in ['0','1']) then begin
     127  for I := 1 to Length(BinStr) do begin
     128    if not (BinStr[I] in ['0','1']) then begin
    120129      RetVar := 0;
    121130      Break;
    122131    end;
    123     RetVar := (RetVar shl 1) + (byte(BinStr[i]) and 1) ;
     132    RetVar := (RetVar shl 1) + (Byte(BinStr[I]) and 1);
    124133  end;
    125134
    … …  
    136145  end;
    137146end;
    138 
    139147
    140148procedure DeleteFiles(APath, AFileSpec: string);
    … …  
    154162  FindClose(SearchRec);
    155163end;
    156 
    157164
    158165function GetFileFilterItemExt(Filter: string; Index: Integer): string;
    … …  
    177184  if FileExt <> '.*' then
    178185    FileDialog.FileName := ChangeFileExt(FileDialog.FileName, FileExt)
     186end;
     187
     188function GetEnvironmentVariables: TStringArray;
     189var
     190  I: Integer;
     191begin
     192  SetLength(Result, GetEnvironmentVariableCount);
     193  for I := 0 to GetEnvironmentVariableCount - 1 do
     194    Result[I] := GetEnvironmentString(I);
    179195end;
    180196
    … …  
    219235end;*)
    220236
     237function Implode(Separator: string; List: array of string): string;
     238var
     239  I: Integer;
     240begin
     241  Result := '';
     242  for I := 0 to Length(List) - 1 do begin
     243    Result := Result + List[I];
     244    if I < Length(List) - 1 then Result := Result + Separator;
     245  end;
     246end;
     247
    221248function Implode(Separator: string; List: TStringList; Around: string = ''): string;
    222249var
    … …  
    494521end;
    495522
    496 procedure ExecuteProgram(Executable: string; Parameters: array of string);
     523procedure ExecuteProgram(Executable: string; Parameters: array of string;
     524  Environment: array of string; CurrentDirectory: string = '');
    497525var
    498526  Process: TProcess;
    499527  I: Integer;
    500528begin
     529  Process := TProcess.Create(nil);
    501530  try
    502     Process := TProcess.Create(nil);
    503531    Process.Executable := Executable;
    504532    for I := 0 to Length(Parameters) - 1 do
    505533      Process.Parameters.Add(Parameters[I]);
     534    for I := 0 to Length(Environment) - 1 do
     535      Process.Environment.Add(Environment[I]);
     536    Process.CurrentDirectory := CurrentDirectory;
     537    Process.ShowWindow := swoHIDE;
    506538    Process.Options := [poNoConsole];
    507539    Process.Execute;
    … …  
    511543end;
    512544
     545procedure ExecuteProgramOutput(Executable: string; Parameters: array of string;
     546  Environment: array of string; out Output, Error: string; out ExitCode: Integer;
     547  CurrentDirectory: string);
     548var
     549  Process: TProcess;
     550  I: Integer;
     551  ReadCount: Integer;
     552  Buffer: string;
     553const
     554  BufferSize = 1000;
     555begin
     556  Process := TProcess.Create(nil);
     557  try
     558    Process.Executable := Executable;
     559    for I := 0 to Length(Parameters) - 1 do
     560      Process.Parameters.Add(Parameters[I]);
     561    for I := 0 to Length(Environment) - 1 do
     562      Process.Environment.Add(Environment[I]);
     563    Process.CurrentDirectory := CurrentDirectory;
     564    Process.ShowWindow := swoHIDE;
     565    Process.Options := [poNoConsole, poUsePipes];
     566    Process.Execute;
     567
     568    Output := '';
     569    Error := '';
     570    Buffer := '';
     571    SetLength(Buffer, BufferSize);
     572    while Process.Running do begin
     573      if Process.Output.NumBytesAvailable > 0 then begin
     574        ReadCount := Process.Output.Read(Buffer[1], Length(Buffer));
     575        Output := Output + Copy(Buffer, 1, ReadCount);
     576      end;
     577
     578      if Process.Stderr.NumBytesAvailable > 0 then begin
     579        ReadCount := Process.Stderr.Read(Buffer[1], Length(Buffer));
     580        Error := Error + Copy(Buffer, 1, ReadCount)
     581      end;
     582
     583      Sleep(10);
     584    end;
     585
     586    if Process.Output.NumBytesAvailable > 0 then begin
     587      ReadCount := Process.Output.Read(Buffer[1], Length(Buffer));
     588      Output := Output + Copy(Buffer, 1, ReadCount);
     589    end;
     590
     591    if Process.Stderr.NumBytesAvailable > 0 then begin
     592      ReadCount := Process.Stderr.Read(Buffer[1], Length(Buffer));
     593      Error := Error + Copy(Buffer, 1, ReadCount);
     594    end;
     595
     596    ExitCode := Process.ExitCode;
     597
     598    if (ExitCode <> 0) or (Error <> '') then
     599      raise Exception.Create(Format(SExecutionError, [Error, ExitCode]));
     600  finally
     601    Process.Free;
     602  end;
     603end;
     604
    513605procedure FreeThenNil(var Obj);
    514606begin
    … …  
    529621procedure OpenFileInShell(FileName: string);
    530622begin
    531   ExecuteProgram('cmd.exe', ['/c', 'start', FileName]);
     623  ExecuteProgram('cmd.exe', ['/c', 'start', FileName], []);
    532624end;
    533625

  • tags/1.3.0/Target.pas

    r151 r162  
    8080  protected
    8181    FCompiledExtension: string;
    82     FRunExtension: string;
    8382    FSourceExtension: string;
    8483    FName: string;
    … …  
    118117    procedure Compile; virtual;
    119118    procedure CompileToFile; virtual;
     119    function GetSourceFileName: string; virtual;
     120    function GetCompileParams: TStringArray; virtual;
     121    function GetCompileFileName: string; virtual;
    120122    procedure RunFromFile; virtual;
     123    function GetRunParams: TStringArray; virtual;
    121124    procedure Run; virtual;
    122125    procedure Pause; virtual;
    … …  
    129132    procedure SaveToRegistry(Context: TRegistryContext); virtual;
    130133    property SourceExtension: string read FSourceExtension;
    131     property RunExtension: string read FRunExtension;
    132134    property CompiledExtension: string read FCompiledExtension;
    133135    property Name: string read FName;
    … …  
    183185
    184186uses
    185   FormConsole;
     187  FormConsole, Common;
    186188
    187189procedure UpdateTranslation;
    … …  
    491493procedure TTarget.CompileToFile;
    492494var
    493   Process: TProcess;
    494   CompiledFile: string;
     495  SourceFile: string;
    495496  Lines: TStringList;
    496   I: Integer;
    497 begin
    498   CompiledFile := ExtractFilePath(ProjectFileName) +
    499     CompiledDir + DirectorySeparator + Name + DirectorySeparator +
    500     ExtractFileNameOnly(ProjectFileName) + SourceExtension;
    501   ForceDirectories(ExtractFilePath(CompiledFile));
     497  Output, Error: string;
     498  Executable: string;
     499  Parameters: array of string;
     500begin
     501  SourceFile := GetSourceFileName;
     502  ForceDirectories(ExtractFilePath(SourceFile));
    502503  with TStringList.Create do
    503504  try
    504505    Text := FTargetCode;
    505     SaveToFile(CompiledFile);
     506    SaveToFile(SourceFile);
    506507  finally
    507508    Free;
    508509  end;
    509510  if CompilerPath <> '' then begin;
    510     if FileExists(CompilerPath) then
    511     try
    512       Process := TProcess.Create(nil);
    513       Process.CurrentDirectory := ExtractFilePath(CompiledFile);
    514       Process.Executable := LongFileName(CompilerPath);
    515       Process.Parameters.Add(LongFileName(CompiledFile));
    516       for I := 0 to GetEnvironmentVariableCount - 1 do
    517         Process.Environment.Add(GetEnvironmentString(I));
    518       Process.Options := [poWaitOnExit, poUsePipes];
    519       Process.Execute;
     511    if FileExists(CompilerPath) then begin
     512      Executable := LongFileName(CompilerPath);
     513      Parameters := GetCompileParams;
     514
     515      ExecuteProgramOutput(Executable, GetCompileParams, GetEnvironmentVariables,
     516        Output, Error, ExitCode, ExtractFilePath(SourceFile));
     517
    520518      if Assigned(FOnLog) then begin
    521519        Lines := TStringList.Create;
    522         Lines.LoadFromStream(Process.Output);
    523         Lines.Insert(0, Process.Executable + ' ' + Process.Parameters.Text);
     520        Lines.Text := Output;
     521        Lines.Insert(0, Executable + ' ' + Implode(',', Parameters));
    524522        FOnLog(Lines);
    525523        Lines.Free;
    526524      end;
    527     finally
    528       Process.Free;
     525
    529526    end else raise Exception.Create(Format(SCompilerNotFound, [CompilerPath]));
    530527  end;
    531528end;
    532529
    533 procedure TTarget.RunFromFile;
    534 var
    535   CompiledFile: string;
    536   RunFile: string;
    537   FormConsole: TFormConsole;
    538 begin
    539   CompiledFile := ExtractFilePath(ProjectFileName) +
     530function TTarget.GetSourceFileName: string;
     531begin
     532  Result := ExtractFilePath(ProjectFileName) +
     533    CompiledDir + DirectorySeparator + Name + DirectorySeparator +
     534    ExtractFileNameOnly(ProjectFileName) + SourceExtension;
     535end;
     536
     537function TTarget.GetCompileParams: TStringArray;
     538begin
     539  Result := [LongFileName(GetSourceFileName)];
     540end;
     541
     542function TTarget.GetCompileFileName: string;
     543begin
     544  Result := ExtractFilePath(ProjectFileName) +
    540545    CompiledDir + DirectorySeparator + Name + DirectorySeparator +
    541546    ExtractFileNameOnly(ProjectFileName) + CompiledExtension;
    542   RunFile := ExtractFilePath(ProjectFileName) +
    543     CompiledDir + DirectorySeparator + Name + DirectorySeparator +
    544     ExtractFileNameOnly(ProjectFileName) + RunExtension;
     547end;
     548
     549procedure TTarget.RunFromFile;
     550var
     551  CompiledFile: string;
     552  FormConsole: TFormConsole;
     553  Parameters: TStringArray;
     554  I: Integer;
     555begin
     556  CompiledFile := GetCompileFileName;
    545557  if FileExists(CompiledFile) then
    546558  try
    … …  
    550562        raise Exception.Create(Format(SExecutorNotFound, [ExecutorPath]));
    551563      FormConsole.Executable := LongFileName(ExecutorPath);
    552       FormConsole.Parameters.Add(LongFileName(RunFile));
     564      Parameters := GetRunParams;
     565      for I := 0 to Length(Parameters) - 1 do
     566        FormConsole.Parameters.Add(Parameters[I]);
    553567    end else
    554       FormConsole.Executable := LongFileName(RunFile);
     568      FormConsole.Executable := LongFileName(CompiledFile);
    555569    FormConsole.ShowModal;
    556570  finally
    … …  
    558572  end
    559573  else raise Exception.Create(Format(SCompiledFileNotFound, [CompiledFile]));
     574end;
     575
     576function TTarget.GetRunParams: TStringArray;
     577begin
     578  Result := [LongFileName(GetCompileFileName)];
    560579end;
    561580

  • tags/1.3.0/Target/TargetC.pas

    r146 r162  
    1515    function GetMemoryCell: string;
    1616  public
     17    function GetCompileParams: TStringArray; override;
    1718    constructor Create; override;
    1819    procedure Compile; override;
    19     procedure CompileToFile; override;
    2020    procedure Run; override;
    2121  end;
    … …  
    2323
    2424implementation
     25
     26uses
     27  Common;
    2528
    2629{ TTargetC }
    … …  
    3639  CompilerPath := 'c:\Program Files\MinGW\bin\gcc.exe';
    3740  FCompiledExtension := '.exe';
    38   FRunExtension := '';
    3941  {$ENDIF}
    4042  {$IFDEF UNIX}
    4143  CompilerPath := '/usr/bin/gcc';
    4244  FCompiledExtension := '';
    43   FRunExtension := '';
    4445  {$ENDIF}
    4546end;
    … …  
    5354    Result := Result + ' - ' + IntToStr(Abs(FProgram[FProgramIndex].RelIndex));
    5455  Result := Result + ']';
     56end;
     57
     58function TTargetC.GetCompileParams: TStringArray;
     59begin
     60  Result := [GetSourceFileName, '-o', GetCompileFileName];
    5561end;
    5662
    … …  
    101107end;
    102108
    103 procedure TTargetC.CompileToFile;
    104 var
    105   Process: TProcess;
    106   CompiledFile: string;
    107 begin
    108   CompiledFile := ExtractFilePath(ProjectFileName) +
    109     CompiledDir + DirectorySeparator + Name + DirectorySeparator +
    110     ExtractFileNameOnly(ProjectFileName) + SourceExtension;
    111   ForceDirectoriesUTF8(ExtractFilePath(CompiledFile));
    112   with TStringList.Create do
    113   try
    114     Text := FTargetCode;
    115     SaveToFile(CompiledFile);
    116   finally
    117     Free;
    118   end;
    119   if FileExistsUTF8(CompilerPath) then
    120   try
    121     Process := TProcess.Create(nil);
    122     Process.CurrentDirectory := ExtractFilePath(CompilerPath);
    123     Process.Executable := LongFileName(CompilerPath);
    124     Process.Parameters.Add(LongFileName(CompiledFile));
    125     Process.Parameters.Add('-o');
    126     Process.Parameters.Add(LongFileName(ExtractFilePath(CompiledFile) + ExtractFileNameOnly(CompiledFile) + CompiledExtension));
    127     Process.Options := [poWaitOnExit];
    128     Process.Execute;
    129   finally
    130     Process.Free;
    131   end else raise Exception.Create(Format(SCompilerNotFound, [CompilerPath]));
    132 end;
    133 
    134109procedure TTargetC.Run;
    135110begin

  • tags/1.3.0/Target/TargetCSharp.pas

    r153 r162  
    3030  FSourceExtension := '.cs';
    3131  FCompiledExtension := '.exe';
    32   FRunExtension := '.exe';
    3332  FImageIndex := 27;
    3433  FCapabilities := [tcCompile, tcRun];

  • tags/1.3.0/Target/TargetDelphi.pas

    r146 r162  
    2929  FSourceExtension := '.pas';
    3030  FImageIndex := 22;
     31  FCapabilities := [tcCompile];
     32  {$IFDEF Windows}
    3133  FCapabilities := [tcCompile, tcRun];
    32   {$IFDEF Windows}
    3334  CompilerPath := 'c:\Program Files\Embarcadero\RAD Studio\9.0\bin\DCC32.EXE';
    3435  FCompiledExtension := '.exe';
    35   FRunExtension := '';
    3636  {$ENDIF}
    3737end;

  • tags/1.3.0/Target/TargetFPC.pas

    r146 r162  
    3333  FCompiledExtension := '.exe';
    3434  CompilerPath := 'fpc.exe';
    35   FRunExtension := '';
    3635  {$ENDIF}
    3736  {$IFDEF UNIX}
    3837  FCompiledExtension := '';
    3938  CompilerPath := '/usr/bin/fpc';
    40   FRunExtension := '';
    4139  {$ENDIF}
    4240end;

  • tags/1.3.0/Target/TargetJava.pas

    r153 r162  
    44
    55uses
    6   Classes, SysUtils, FileUtil, Target, BFTarget, Dialogs;
     6  Classes, SysUtils, FileUtil, Target, BFTarget, Dialogs, LazFileUtils;
    77
    88type
    … …  
    1414    function GetMemoryCell: string;
    1515  public
     16    function GetRunParams: TStringArray; override;
    1617    constructor Create; override;
    1718    procedure Compile; override;
    … …  
    3031  FSourceExtension := '.java';
    3132  FCompiledExtension := '.class';
    32   FRunExtension := '.class';
    3333  FImageIndex := 24;
    3434  FCapabilities := [tcCompile, tcRun];
    … …  
    5151    Result := Result + ' - ' + IntToStr(Abs(FProgram[FProgramIndex].RelIndex));
    5252  Result := Result + ']';
     53end;
     54
     55function TTargetJava.GetRunParams: TStringArray;
     56begin
     57  Result := ['-classpath', ExtractFileDir(GetCompileFileName), ExtractFileNameOnly(GetCompileFileName)];
    5358end;
    5459

  • tags/1.3.0/Target/TargetJavascript.pas

    r145 r162  
    3636  CompilerPath := '';
    3737  FCompiledExtension := '';
    38   FRunExtension := '';
    3938end;
    4039

  • tags/1.3.0/Target/TargetPHP.pas

    r145 r162  
    2929  FName := 'PHP';
    3030  FSourceExtension := '.php';
    31   FRunExtension := '.php';
    3231  FCompiledExtension := '.php';
    3332  FImageIndex := 21;

  • tags/1.3.0/Target/TargetPython.pas

    r148 r162  
    2929  FName := 'Python';
    3030  FSourceExtension := '.py';
    31   FRunExtension := '.py';
    3231  FCompiledExtension := '.py';
    3332  FImageIndex := 26;

  • tags/1.3.0/Target/TargetRust.pas

    r150 r162  
    1515    function GetMemoryCell: string;
    1616  public
     17    function GetCompileParams: TStringArray; override;
    1718    constructor Create; override;
    1819    procedure Compile; override;
    19     procedure CompileToFile; override;
    2020    procedure Run; override;
    2121  end;
    … …  
    2323
    2424implementation
     25
     26uses
     27  Common;
    2528
    2629{ TTargetRust }
    … …  
    3639  CompilerPath := 'c:\Program Files\Rust\rustc.exe';
    3740  FCompiledExtension := '.exe';
    38   FRunExtension := '';
    3941  {$ENDIF}
    4042  {$IFDEF UNIX}
    4143  CompilerPath := '/usr/bin/rustc';
    4244  FCompiledExtension := '';
    43   FRunExtension := '';
    4445  {$ENDIF}
    4546end;
    … …  
    5354    Result := Result + ' - ' + IntToStr(Abs(FProgram[FProgramIndex].RelIndex));
    5455  Result := Result + ']';
     56end;
     57
     58function TTargetRust.GetCompileParams: TStringArray;
     59begin
     60  Result := [GetSourceFileName, '-o', GetCompileFileName];
    5561end;
    5662
    … …  
    110116end;
    111117
    112 procedure TTargetRust.CompileToFile;
    113 var
    114   Process: TProcess;
    115   CompiledFile: string;
    116 begin
    117   CompiledFile := ExtractFilePath(ProjectFileName) +
    118     CompiledDir + DirectorySeparator + Name + DirectorySeparator +
    119     ExtractFileNameOnly(ProjectFileName) + SourceExtension;
    120   ForceDirectoriesUTF8(ExtractFilePath(CompiledFile));
    121   with TStringList.Create do
    122   try
    123     Text := FTargetCode;
    124     SaveToFile(CompiledFile);
    125   finally
    126     Free;
    127   end;
    128   if FileExistsUTF8(CompilerPath) then
    129   try
    130     Process := TProcess.Create(nil);
    131     Process.CurrentDirectory := ExtractFilePath(CompilerPath);
    132     Process.Executable := LongFileName(CompilerPath);
    133     Process.Parameters.Add(LongFileName(CompiledFile));
    134     Process.Parameters.Add('-o');
    135     Process.Parameters.Add(LongFileName(ExtractFilePath(CompiledFile) + ExtractFileNameOnly(CompiledFile) + CompiledExtension));
    136     Process.Options := [poWaitOnExit];
    137     Process.Execute;
    138   finally
    139     Process.Free;
    140   end else raise Exception.Create(Format(SCompilerNotFound, [CompilerPath]));
    141 end;
    142 
    143118procedure TTargetRust.Run;
    144119begin
Note: See TracChangeset for help on using the changeset viewer.