瀏覽代碼

--- Merging r39691 into '.':
U packages/chm/src/chmcmd.lpi
--- Recording mergeinfo for merge of r39691 into '.':
U .
--- Merging r39758 into '.':
U packages/fcl-base/src/fpexprpars.pp
--- Recording mergeinfo for merge of r39758 into '.':
G .
--- Merging r39831 into '.':
U packages/fcl-net/src/ssockets.pp
--- Recording mergeinfo for merge of r39831 into '.':
G .
--- Merging r39840 into '.':
U rtl/inc/fexpand.inc
U tests/test/units/dos/tfexpand.pp
--- Recording mergeinfo for merge of r39840 into '.':
G .
--- Merging r39843 into '.':
U rtl/objpas/sysutils/syshelp.inc
--- Recording mergeinfo for merge of r39843 into '.':
G .

# revisions: 39691,39758,39831,39840,39843

git-svn-id: branches/fixes_3_2@40527 -

marco 6 年之前
父節點
當前提交
fa58ed1df7

+ 3 - 15
packages/chm/src/chmcmd.lpi

@@ -1,7 +1,7 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <General>
       <Flags>
         <LRSInOutputDirectory Value="False"/>
@@ -12,7 +12,6 @@
     <VersionInfo>
       <Language Value=""/>
       <CharSet Value=""/>
-      <StringTable ProductVersion=""/>
     </VersionInfo>
     <BuildModes Count="1">
       <Item1 Name="default" Default="True"/>
@@ -33,14 +32,13 @@
       <Unit0>
         <Filename Value="chmcmd.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="chmcmd"/>
       </Unit0>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
     <SearchPaths>
-      <OtherUnitFiles Value="/home/andrew/programming/projects/chmmaker/;/home/andrew/programming/lazarus/components/chmhelp/packages/chm/;/home/andrew/programming/projects/lzxcompress/"/>
+      <OtherUnitFiles Value="/home/andrew/programming/projects/chmmaker;/home/andrew/programming/lazarus/components/chmhelp/packages/chm;/home/andrew/programming/projects/lzxcompress"/>
     </SearchPaths>
     <Parsing>
       <SyntaxOptions>
@@ -53,16 +51,6 @@
         <OptimizationLevel Value="2"/>
       </Optimizations>
     </CodeGeneration>
-    <Linking>
-      <Debugging>
-        <UseHeaptrc Value="True"/>
-        <UseValgrind Value="True"/>
-        <GenGProfCode Value="True"/>
-      </Debugging>
-    </Linking>
-    <Other>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="2">

+ 1 - 1
packages/fcl-base/src/fpexprpars.pp

@@ -1967,7 +1967,7 @@ begin
     else
       begin
       Val(CurrentToken,X,C);
-      If (I=0) then
+      If (C=0) then
         Result:=TFPConstExpression.CreateFloat(X)
       else
         ParserError(Format(SErrInvalidFloat,[CurrentToken]));

+ 1 - 1
packages/fcl-net/src/ssockets.pp

@@ -1026,7 +1026,7 @@ begin
     result := FpFcntl(ASocket, F_SetFl, flags and (not O_NONBLOCK)) = 0;
 {$endif}
 {$ifdef windows}
-  result := ioctlsocket(ASocket,FIONBIO,@ABlockMode) = 0;
+  result := ioctlsocket(ASocket,longint(FIONBIO),@ABlockMode) = 0;
 {$endif}
 end;
 

+ 17 - 0
rtl/inc/fexpand.inc

@@ -443,6 +443,23 @@ begin
     {Get string of directories to only process relative references on this one}
     Dirs := Copy (Pa, Succ (PathStart), Length (Pa) - PathStart);
 
+{$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
+ {$IFNDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+    {Before anything else, remove doubled DirectorySeparator characters
+     - technically invalid or at least useless, but ignored by most operating
+     systems except for plain DOS.}
+    I := Pos (DirectorySeparator + DirectorySeparator, Dirs);
+    while I <> 0 do
+        begin
+            J := Succ (I);
+            while (Length (Dirs) > J) and (Dirs [Succ (J)] = DirectorySeparator) do
+                Inc (J);
+            Delete (Dirs, Succ (I), J - I);
+            I := Pos (DirectorySeparator + DirectorySeparator, Dirs);
+        end;
+ {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+{$ENDIF FPC_FEXPAND_DIRSEP_IS_CURDIR}
+
 {$IFNDEF FPC_FEXPAND_NO_CURDIR}
  {$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
     {First remove all references to '\.\'}

+ 1 - 1
rtl/objpas/sysutils/syshelp.inc

@@ -1304,7 +1304,7 @@ begin
     LastSep:=Sep+System.Length(Separators[Match]);
     Sep:=NextSep(LastSep,Match);
     end;
-  if (LastSep<Length-1) and ((ACount=0) or (Len<ACount)) then
+  if (LastSep<Length) and ((ACount=0) or (Len<ACount)) then
     begin
     T:=SubString(LastSep);
 //    Writeln('Examining >',T,'< at pos,',LastSep,' till pos ',Sep);

+ 11 - 0
tests/test/units/dos/tfexpand.pp

@@ -397,6 +397,13 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
  Check ('..', TestDir + TestDir1Name);
  Check ('.' + DirSep + '..', TestDir + TestDir1Name);
  Check ('..' + DirSep + '.', TestDir + TestDir1Name);
+ Check (TestDir + TestDir1Name + DirSep + DirSep + '..' + DirSep, TestDir);
+ Check (TestDir + TestDir1Name + DirSep + '/' + DirSep + '..' + DirSep, TestDir);
+ Check (TestDir + TestDir1Name + DirSep + DirSep + DirSep + '..' + DirSep, TestDir);
+ Check (TestDir + TestDir1Name + DirSep + DirSep + TestDir2Name + DirSep + DirSep + '..',
+                                                                  TestDir + TestDir1Name);
+ Check (TestDir + TestDir1Name + DirSep + DirSep + TestDir2Name + DirSep + DirSep + '..'
+                                               + DirSep + DirSep, TestDir + TestDir1Name + DirSep);
  {$ENDIF NODOTS}
 {$ENDIF MACOS}
 {$IFDEF NETWARE}
@@ -474,6 +481,10 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
  Check ('d\d/d', CurDir + DirSep + 'd' + DirSep + 'd' + DirSep + 'd');
 {$ifdef go32v2}
  { for go32v2 target UNC paths are only handled if LFNSupport is true }
+ { Remark: The previous statement may not be correct, UNC paths were already  }
+ { supported with IBM / Microsoft LAN Manager client on plain DOS before LFN  }
+ { / W95 availability, but that probably doesn't matter for our purposes.     }
+ { See e.g. http://www.drdobbs.com/undocumented-corner/184408984 (TH).        }
  if not LFNSupport then
    writeln('Go32v2 without LFN, no UNC support')
  else