IDE: compiler options: check pas2js: executable

git-svn-id: trunk@56774 -

components/codetools/definetemplates.pas

@@ -1025,7 +1025,9 @@ function GetDefaultCompilerFilename(const TargetCPU: string = ''; Cross: boolean
 procedure GetTargetProcessors(const TargetCPU: string; aList: TStrings);
 function GetFPCTargetOS(TargetOS: string): string;
 function GetFPCTargetCPU(TargetCPU: string): string;
+function GetPascalCompilerFromExeName(Filename: string): TPascalCompiler;
 function IsFPCExecutable(AFilename: string; out ErrorMsg: string): boolean; // not thread-safe
+function IsPas2JSExecutable(AFilename: string; out ErrorMsg: string): boolean; // not thread-safe
 
 // functions to quickly setup some defines
 function CreateDefinesInDirectories(const SourcePaths, FlagName: string
@@ -3644,6 +3646,25 @@ begin
   Result:=LowerCase(TargetCPU);
 end;
 
+function GetPascalCompilerFromExeName(Filename: string): TPascalCompiler;
+var
+  ShortFilename: String;
+begin
+  ShortFilename:=ExtractFileNameOnly(Filename);
+
+  // pas2js*
+  if CompareText(LeftStr(ShortFilename,6),'pas2js')=0 then
+    exit(pcPas2js);
+
+  // dcc*.exe
+  if (CompareFilenames(LeftStr(ShortFilename,3),'dcc')=0)
+  and ((ExeExt='') or (CompareFileExt(Filename,ExeExt)=0))
+  then
+    exit(pcDelphi);
+
+  Result:=pcFPC;
+end;
+
 function IsFPCExecutable(AFilename: string; out ErrorMsg: string): boolean;
 var
   ShortFilename: String;
@@ -3681,12 +3702,48 @@ begin
     exit(true);
 
   // allow ppcxxx.exe
-  if (CompareFilenames(copy(ShortFilename,1,3),'ppc')=0)
+  if (CompareFilenames(LeftStr(ShortFilename,3),'ppc')=0)
   and ((ExeExt='') or (CompareFileExt(AFilename,ExeExt)=0))
   then
     exit(true);
 
-  ErrorMsg:='unknown file name';
+  ErrorMsg:='fpc executable should start with fpc or ppc';
+end;
+
+function IsPas2JSExecutable(AFilename: string; out ErrorMsg: string): boolean;
+var
+  ShortFilename: String;
+begin
+  Result:=false;
+  AFilename:=ResolveDots(aFilename);
+  if aFilename='' then begin
+    ErrorMsg:='missing file name';
+    exit;
+  end;
+  if not FilenameIsAbsolute(AFilename) then begin
+    ErrorMsg:='file missing path';
+    exit;
+  end;
+  if not FileExistsCached(AFilename) then begin
+    ErrorMsg:='file not found';
+    exit;
+  end;
+  if DirPathExistsCached(AFilename) then begin
+    ErrorMsg:='file is a directory';
+    exit;
+  end;
+  if not FileIsExecutableCached(AFilename) then begin
+    ErrorMsg:='file is not executable';
+    exit;
+  end;
+  ErrorMsg:='';
+
+  // allow scripts like pas2js*
+  ShortFilename:=ExtractFileNameOnly(AFilename);
+  if CompareText(LeftStr(ShortFilename,6),'pas2js')=0 then
+    exit(true);
+
+  ErrorMsg:='pas2js executable should start with pas2js';
 end;
 
 function CreateDefinesInDirectories(const SourcePaths, FlagName: string

ide/frames/compiler_compilation_options.pas

@@ -9,7 +9,7 @@ uses
   Classes, sysutils,
   Controls, StdCtrls, Dialogs, ComboEx,
   // CodeTools
-  FileProcs, DefineTemplates, CodeToolManager,
+  FileProcs, DefineTemplates, CodeToolManager, LinkScanner,
   // LazUtils
   FileUtil, LazFileUtils,
   // IDEIntf
@@ -81,6 +81,20 @@ implementation
 
 procedure TCompilerCompilationOptionsFrame.CompCmdBrowseButtonClick(
   Sender: TObject);
+
+  function ShowQuality(Quality: TSDFilenameQuality;
+    const Filename, Note: string): boolean;
+  begin
+    if Quality<>sddqCompatible then begin
+      if IDEMessageDialog(lisCCOWarningCaption, Format(
+        lisTheCompilerFileDoesNotLookCorrect, [Filename, #13, Note]),
+        mtWarning,[mbIgnore,mbCancel])<>mrIgnore
+      then
+        exit(false);
+    end;
+    Result:=true;
+  end;
+
 var
   OpenDialog: TOpenDialog;
   NewFilename: string;
@@ -90,6 +104,7 @@ var
   OldFilename: string;
   OldParams: string;
   Combo: TComboBox;
+  ok: Boolean;
 begin
   OpenDialog:=TOpenDialog.Create(nil);
   try
@@ -115,31 +130,41 @@ begin
 
     if not OpenDialog.Execute then exit;
     NewFilename:=TrimAndExpandFilename(OpenDialog.Filename);
+    // check, even if new file is old filename, so the user see the warnings again
+    ok:=false;
     if Sender=BrowseCompilerButton then begin
       // check compiler filename
-      if IsFPCExecutable(NewFilename,s) then begin
-        // check compiler
-        Quality:=CheckCompilerQuality(NewFilename,Note,
-                                   CodeToolBoss.FPCDefinesCache.TestFilename);
-        if Quality<>sddqCompatible then begin
-          if IDEMessageDialog(lisCCOWarningCaption, Format(
-            lisTheCompilerFileDoesNotLookCorrect, [NewFilename, #13, Note]),
-            mtWarning,[mbIgnore,mbCancel])<>mrIgnore
-          then
-            exit;
+      case GetPascalCompilerFromExeName(NewFilename) of
+      pcPas2js:
+        if IsPas2JSExecutable(NewFilename,s) then begin
+          // check pas2js
+          Quality:=CheckPas2jsQuality(NewFilename,Note,
+                                     CodeToolBoss.FPCDefinesCache.TestFilename);
+          if not ShowQuality(Quality,NewFilename,Note) then exit;
+          ok:=true;
+        end;
+      else
+        if IsFPCExecutable(NewFilename,s) then begin
+          // check fpc
+          Quality:=CheckCompilerQuality(NewFilename,Note,
+                                     CodeToolBoss.FPCDefinesCache.TestFilename);
+          if not ShowQuality(Quality,NewFilename,Note) then exit;
+          ok:=true;
         end;
-      end else begin
-        // maybe a script
-        if not CheckExecutable(OldFilename,NewFilename,lisInvalidExecutable,lisInvalidExecutableMessageText)
-        then
-          exit;
       end;
+      // maybe a script
+      if (not ok)
+      and not CheckExecutable(OldFilename,NewFilename,lisInvalidExecutable,lisInvalidExecutableMessageText)
+      then
+        exit;
+      ok:=true;
     end else if (Sender=ExecBeforeBrowseButton)
     or (Sender=ExecAfterBrowseButton) then begin
       // check executable
       if not CheckExecutable(OldFilename,NewFilename,lisInvalidExecutable,lisInvalidExecutableMessageText)
       then
         exit;
+      ok:=true;
     end;
     SetComboBoxText(Combo,NewFilename,cstFilename);
   finally

ide/initialsetupproc.pas

@@ -87,13 +87,17 @@ function CheckLazarusDirectoryQuality(ADirectory: string; out Note: string): TSD
 function SearchLazarusDirectoryCandidates(StopIfFits: boolean): TSDFileInfoList;
 procedure SetupLazarusDirectory;
 
-// Compiler
+// FreePascal Compiler
 function CheckCompilerQuality(AFilename: string; out Note: string;
   TestSrcFilename: string): TSDFilenameQuality;
 function SearchCompilerCandidates(StopIfFits: boolean;
   const TestSrcFilename: string): TSDFileInfoList;
 procedure SetupCompilerFilename;
 
+// Pas2js compiler
+function CheckPas2jsQuality(AFilename: string; out Note: string;
+  TestSrcFilename: string): TSDFilenameQuality;
+
 // FPC Source
 function CheckFPCSrcDirQuality(ADirectory: string; out Note: string;
   const FPCVer: String; aUseFileCache: Boolean = True): TSDFilenameQuality;
@@ -349,7 +353,7 @@ begin
   // do not execute unusual exe files
   ShortFilename:=ExtractFileNameOnly(AFilename);
   if (CompareFilenames(ShortFilename,'fpc')<>0)
-  and (CompareFilenames(copy(ShortFilename,1,3),'ppc')<>0)
+  and (CompareFilenames(LeftStr(ShortFilename,3),'ppc')<>0)
   then begin
     Note:=lisUnusualCompilerFileNameUsuallyItStartsWithFpcPpcOr;
     exit(sddqIncomplete);
@@ -582,6 +586,58 @@ begin
   end;
 end;
 
+function CheckPas2jsQuality(AFilename: string; out Note: string;
+  TestSrcFilename: string): TSDFilenameQuality;
+var
+  i: LongInt;
+  ShortFilename: String;
+  CfgCache: TFPCTargetConfigCache;
+begin
+  Result:=sddqInvalid;
+  AFilename:=TrimFilename(AFilename);
+  if not FileExistsCached(AFilename) then
+  begin
+    Note:=lisFileNotFound4;
+    exit;
+  end;
+  if DirPathExistsCached(AFilename) then
+  begin
+    Note:=lisFileIsDirectory;
+    exit;
+  end;
+  if not FileIsExecutableCached(AFilename) then
+  begin
+    Note:=lisFileIsNotAnExecutable;
+    exit;
+  end;
+
+  // do not execute unusual exe files
+  ShortFilename:=ExtractFileNameOnly(AFilename);
+  if (CompareText(LeftStr(ShortFilename,6),'pas2js')<>0)
+  then begin
+    Note:=lisUnusualPas2jsCompilerFileNameUsuallyItStartsWithPa;
+    exit(sddqIncomplete);
+  end;
+
+  if TestSrcFilename<>'' then
+  begin
+    CfgCache:=CodeToolBoss.FPCDefinesCache.ConfigCaches.Find(
+                                                       AFilename,'','','',true);
+    if CfgCache.NeedsUpdate then
+      CfgCache.Update(TestSrcFilename);
+    i:=CfgCache.IndexOfUsedCfgFile;
+    if i<0 then
+    begin
+      Note:=lisFpcCfgIsMissing;
+      exit;
+    end;
+    //if not CheckPas('classes') then exit;
+  end;
+
+  Note:=lisOk;
+  Result:=sddqCompatible;
+end;
+
 function CheckFPCSrcDirQuality(ADirectory: string; out Note: string;
   const FPCVer: String; aUseFileCache: Boolean = True): TSDFilenameQuality;
 // aUseFileCache = False when this function is called from a thread.

ide/lazarusidestrconsts.pas

@@ -6109,6 +6109,8 @@ resourcestring
   lisFPCSources = 'FPC sources';
   lisConfigureLazarusIDE = 'Configure Lazarus IDE';
   lisFileIsNotAnExecutable = 'File is not an executable';
+  lisUnusualPas2jsCompilerFileNameUsuallyItStartsWithPa = 'Unusual pas2js '
+    +'compiler file name. Usually it starts with pas2js.';
   lisThereIsNoFpcExeInTheDirectoryOfUsuallyTheMakeExecu = 'There is no fpc.exe'
     +' in the directory of %s. Usually the make executable is installed '
     +'together with the FPC compiler.';