more fixing and allow pas2c to run tests. they will still fail though - engine does not exit with the specified exit codes, also data types are messed up
authorsheepluva
Sat, 29 Nov 2014 05:15:27 +0100
changeset 10564 0cb20aa8877a
parent 10562 3388822b3914
child 10566 cc90ea6448c7
more fixing and allow pas2c to run tests. they will still fail though - engine does not exit with the specified exit codes, also data types are messed up
hedgewars/pas2cRedo.pas
hedgewars/uLandGenTemplateBased.pas
hedgewars/uPhysFSLayer.pas
project_files/hwc/rtl/SysUtils.h
project_files/hwc/rtl/sysutils.c
--- a/hedgewars/pas2cRedo.pas	Sat Nov 29 03:13:06 2014 +0100
+++ b/hedgewars/pas2cRedo.pas	Sat Nov 29 05:15:27 2014 +0100
@@ -84,6 +84,7 @@
      min, max:function:integer;
     assign, rewrite, rewrite_2, reset, reset_2, flush, BlockWrite, BlockRead, close : procedure;
     FileExists, DirectoryExists, eof : function : boolean;
+    ExtractFileDir : function : string;
     ExtractFileName : function : string;
 
     ParamCount : function : integer;
--- a/hedgewars/uLandGenTemplateBased.pas	Sat Nov 29 03:13:06 2014 +0100
+++ b/hedgewars/uLandGenTemplateBased.pas	Sat Nov 29 05:15:27 2014 +0100
@@ -18,7 +18,7 @@
     with Template do
         begin
         pa.Count:= BasePointsCount;
-        for i:= 0 to LongInt(pred(pa.Count)) do
+        for i:= 0 to pred(LongInt(pa.Count)) do
             begin
             pa.ar[i].x:= BasePoints^[i].x + LongInt(GetRandom(BasePoints^[i].w));
             if pa.ar[i].x <> NTPX then
@@ -174,7 +174,7 @@
 
     // now go through all other segments
     fp:= pa.ar[0];
-    for i:= 0 to pa.Count - 2 do
+    for i:= 0 to LongInt(pa.Count) - 2 do
         if pa.ar[i].x = NTPX then
             fp:= pa.ar[i + 1]
         else if (i <> si) then
@@ -210,7 +210,7 @@
         end;
 
     // go through all points, including fill points
-    for i:= 0 to Pred(pa.Count + fillPointsCount) do
+    for i:= 0 to Pred(LongInt(pa.Count + fillPointsCount)) do
         // if this point isn't on current segment
         if (si <> i) and (i <> si + 1) and (pa.ar[i].x <> NTPX) then
         begin
@@ -294,7 +294,7 @@
     newPoint.y:= 0;
     i:= 0;
 
-    while i < pa.Count - 1 do
+    while i < LongInt(pa.Count) - 1 do
     begin
         FindPoint(i, fillPointsCount, newPoint, pa);
 
--- a/hedgewars/uPhysFSLayer.pas	Sat Nov 29 03:13:06 2014 +0100
+++ b/hedgewars/uPhysFSLayer.pas	Sat Nov 29 05:15:27 2014 +0100
@@ -179,13 +179,11 @@
     // need access to teams and frontend configs (for bindings)
     pfsMountAtRoot(UserPathPrefix);
 
-    {$IFNDEF PAS2C}
     if cTestLua then
         begin
-            pfsMountAtRoot(ExtractFileDir(cScriptName));
+            pfsMountAtRoot(ansistring(ExtractFileDir(cScriptName)));
             cScriptName := ExtractFileName(cScriptName);
         end;
-    {$ENDIF}
 end;
 
 procedure freeModule;
--- a/project_files/hwc/rtl/SysUtils.h	Sat Nov 29 03:13:06 2014 +0100
+++ b/project_files/hwc/rtl/SysUtils.h	Sat Nov 29 05:15:27 2014 +0100
@@ -31,6 +31,9 @@
 #define     StrToInt                fpcrtl_strToInt
 #define     strToInt                fpcrtl_strToInt
 
+string255   fpcrtl_extractFileDir(string255 f);
+#define     fpcrtl_ExtractFileDir  fpcrtl_extractFileDir
+
 string255   fpcrtl_extractFileName(string255 f);
 #define     fpcrtl_ExtractFileName  fpcrtl_extractFileName
 
--- a/project_files/hwc/rtl/sysutils.c	Sat Nov 29 03:13:06 2014 +0100
+++ b/project_files/hwc/rtl/sysutils.c	Sat Nov 29 05:15:27 2014 +0100
@@ -131,6 +131,24 @@
     return atoi(s.str);
 }
 
+string255 fpcrtl_extractFileDir(string255 f)
+{
+    const char sep[] = {'\\', '/', ':'};
+    LongInt i,j;
+
+    i = f.len - 1;
+    while(i >= 0){
+        for(j = 0; j < sizeof(sep); j++){
+            if(f.str[i] == sep[j]){
+                goto FPCRTL_EXTRACTFILEDIR_END;
+            }
+        }
+        i--;
+    }
+FPCRTL_EXTRACTFILEDIR_END:
+    return fpcrtl_copy(f, 1, i);
+}
+
 //function ExtractFileName(const FileName: string): string;
 //var
 //  i : longint;