ソースを参照

Move several path related functions from dotest program to testu unit for use in dosbox_wrapper program

git-svn-id: trunk@38648 -
pierre 7 年 前
コミット
a07b191847
2 ファイル変更141 行追加125 行削除
  1. 3 125
      tests/utils/dotest.pp
  2. 138 0
      tests/utils/testu.pp

+ 3 - 125
tests/utils/dotest.pp

@@ -115,12 +115,6 @@ const
   TargetCanCompileLibraries : boolean = true;
   UniqueSuffix: string = '';
 
-{ Constants used in IsAbsolute function }
-  TargetHasDosStyleDirectories : boolean = false;
-  TargetAmigaLike : boolean = false;
-  TargetIsMacOS : boolean = false;
-  TargetIsUnix : boolean = false;
-
 
 const
   NoSharedLibSupportPattern='$nosharedlib';
@@ -137,71 +131,6 @@ begin
   AConfig.SkipTarget:=ReplaceText(AConfig.SkipTarget, NoWorkingThread, TargetHasNoWorkingThreadSupport);
 end;
 
-{ extracted from rtl/macos/macutils.inc }
-
-function IsMacFullPath (const path: string): Boolean;
-  begin
-    if Pos(':', path) = 0 then    {its partial}
-      IsMacFullPath := false
-    else if path[1] = ':' then
-      IsMacFullPath := false
-    else
-      IsMacFullPath := true
-  end;
-
-
-Function IsAbsolute (Const F : String) : boolean;
-{
-  Returns True if the name F is a absolute file name
-}
-begin
-  IsAbsolute:=false;
-  if TargetHasDosStyleDirectories then
-    begin
-      if (F[1]='/') or (F[1]='\') then
-        IsAbsolute:=true;
-      if (Length(F)>2) and (F[2]=':') and ((F[3]='\') or (F[3]='/')) then
-        IsAbsolute:=true;
-    end
-  else if TargetAmigaLike then
-    begin
-      if (length(F)>0) and (Pos(':',F) <> 0) then
-        IsAbsolute:=true;
-    end
-  else if TargetIsMacOS then
-    begin
-      IsAbsolute:=IsMacFullPath(F);
-    end
-  { generic case }
-  else if (F[1]='/') then
-    IsAbsolute:=true;
-end;
-
-Function FileExists (Const F : String) : Boolean;
-{
-  Returns True if the file exists, False if not.
-}
-Var
-  info : searchrec;
-begin
-  FindFirst (F,anyfile,Info);
-  FileExists:=DosError=0;
-  FindClose (Info);
-end;
-
-
-Function PathExists (Const F : String) : Boolean;
-{
-  Returns True if the file exists, False if not.
-}
-Var
-  info : searchrec;
-begin
-  FindFirst (F,anyfile,Info);
-  PathExists:=(DosError=0) and (Info.Attr and Directory=Directory);
-  FindClose (Info);
-end;
-
 
 function ToStr(l:longint):string;
 var
@@ -279,60 +208,6 @@ begin
 end;
 
 
-function SplitPath(const s:string):string;
-var
-  i : longint;
-begin
-  i:=Length(s);
-  while (i>0) and not(s[i] in ['/','\'{$IFDEF MACOS},':'{$ENDIF}]) do
-   dec(i);
-  SplitPath:=Copy(s,1,i);
-end;
-
-
-function SplitBasePath(const s:string): string;
-var
-  i : longint;
-begin
-  i:=1;
-  while (i<length(s)) and not(s[i] in ['/','\'{$IFDEF MACOS},':'{$ENDIF}]) do
-   inc(i);
-  if s[i] in  ['/','\'{$IFDEF MACOS},':'{$ENDIF}] then
-    dec(i);
-  SplitBasePath:=Copy(s,1,i);
-end;
-
-Function SplitFileName(const s:string):string;
-var
-  p : dirstr;
-  n : namestr;
-  e : extstr;
-begin
-  FSplit(s,p,n,e);
-  SplitFileName:=n+e;
-end;
-
-Function SplitFileBase(const s:string):string;
-var
-  p : dirstr;
-  n : namestr;
-  e : extstr;
-begin
-  FSplit(s,p,n,e);
-  SplitFileBase:=n;
-end;
-
-Function SplitFileExt(const s:string):string;
-var
-  p : dirstr;
-  n : namestr;
-  e : extstr;
-begin
-  FSplit(s,p,n,e);
-  SplitFileExt:=e;
-end;
-
-
 function ForceExtension(Const HStr,ext:String):String;
 {
   Return a filename which certainly has the extension ext
@@ -1453,6 +1328,9 @@ begin
       {$I+}
       ioresult;
       s:=CurrDir+SplitFileName(TestExe);
+      { Add -Ssource_file_name for dosbox_wrapper }
+      if pos('dosbox_wrapper',EmulatorName)>0 then
+        s:=s+' -S'+PPFile[current];
       execres:=ExecuteEmulated(EmulatorName,s,FullExeLogFile,StartTicks,EndTicks);
       {$I-}
        ChDir(OldDir);

+ 138 - 0
tests/utils/testu.pp

@@ -5,6 +5,8 @@ unit testu;
 
 Interface
 
+uses
+  dos;
 { ---------------------------------------------------------------------
     utility functions, shared by several programs of the test suite
   ---------------------------------------------------------------------}
@@ -61,8 +63,144 @@ procedure Verbose(lvl:TVerboseLevel;const s:string);
 function GetConfig(const fn:string;var r:TConfig):boolean;
 Function GetFileContents (FN : String) : String;
 
+const
+{ Constants used in IsAbsolute function }
+  TargetHasDosStyleDirectories : boolean = false;
+  TargetAmigaLike : boolean = false;
+  TargetIsMacOS : boolean = false;
+  TargetIsUnix : boolean = false;
+
+{ File path helper functions }
+function SplitPath(const s:string):string;
+function SplitBasePath(const s:string): string;
+Function SplitFileName(const s:string):string;
+Function SplitFileBase(const s:string):string;
+Function SplitFileExt(const s:string):string;
+Function FileExists (Const F : String) : Boolean;
+Function PathExists (Const F : String) : Boolean;
+Function IsAbsolute (Const F : String) : boolean;
+
 Implementation
 
+function SplitPath(const s:string):string;
+var
+  i : longint;
+begin
+  i:=Length(s);
+  while (i>0) and not(s[i] in ['/','\'{$IFDEF MACOS},':'{$ENDIF}]) do
+   dec(i);
+  SplitPath:=Copy(s,1,i);
+end;
+
+
+function SplitBasePath(const s:string): string;
+var
+  i : longint;
+begin
+  i:=1;
+  while (i<length(s)) and not(s[i] in ['/','\'{$IFDEF MACOS},':'{$ENDIF}]) do
+   inc(i);
+  if s[i] in  ['/','\'{$IFDEF MACOS},':'{$ENDIF}] then
+    dec(i);
+  SplitBasePath:=Copy(s,1,i);
+end;
+
+Function SplitFileName(const s:string):string;
+var
+  p : dirstr;
+  n : namestr;
+  e : extstr;
+begin
+  FSplit(s,p,n,e);
+  SplitFileName:=n+e;
+end;
+
+Function SplitFileBase(const s:string):string;
+var
+  p : dirstr;
+  n : namestr;
+  e : extstr;
+begin
+  FSplit(s,p,n,e);
+  SplitFileBase:=n;
+end;
+
+Function SplitFileExt(const s:string):string;
+var
+  p : dirstr;
+  n : namestr;
+  e : extstr;
+begin
+  FSplit(s,p,n,e);
+  SplitFileExt:=e;
+end;
+
+
+Function FileExists (Const F : String) : Boolean;
+{
+  Returns True if the file exists, False if not.
+}
+Var
+  info : searchrec;
+begin
+  FindFirst (F,anyfile,Info);
+  FileExists:=DosError=0;
+  FindClose (Info);
+end;
+
+
+Function PathExists (Const F : String) : Boolean;
+{
+  Returns True if the file exists, False if not.
+}
+Var
+  info : searchrec;
+begin
+  FindFirst (F,anyfile,Info);
+  PathExists:=(DosError=0) and (Info.Attr and Directory=Directory);
+  FindClose (Info);
+end;
+
+{ extracted from rtl/macos/macutils.inc }
+
+function IsMacFullPath (const path: string): Boolean;
+  begin
+    if Pos(':', path) = 0 then    {its partial}
+      IsMacFullPath := false
+    else if path[1] = ':' then
+      IsMacFullPath := false
+    else
+      IsMacFullPath := true
+  end;
+
+
+Function IsAbsolute (Const F : String) : boolean;
+{
+  Returns True if the name F is a absolute file name
+}
+begin
+  IsAbsolute:=false;
+  if TargetHasDosStyleDirectories then
+    begin
+      if (F[1]='/') or (F[1]='\') then
+        IsAbsolute:=true;
+      if (Length(F)>2) and (F[2]=':') and ((F[3]='\') or (F[3]='/')) then
+        IsAbsolute:=true;
+    end
+  else if TargetAmigaLike then
+    begin
+      if (length(F)>0) and (Pos(':',F) <> 0) then
+        IsAbsolute:=true;
+    end
+  else if TargetIsMacOS then
+    begin
+      IsAbsolute:=IsMacFullPath(F);
+    end
+  { generic case }
+  else if (F[1]='/') then
+    IsAbsolute:=true;
+end;
+
 procedure Verbose(lvl:TVerboseLevel;const s:string);
 begin
   case lvl of