Update of /cvsroot/fink/dists/10.4/unstable/main/finkinfo/languages
In directory sc8-pr-cvs17:/tmp/cvs-serv5078
Modified Files:
fpc.info
Added Files:
fpc.patch
Log Message:
update from tracker
--- NEW FILE: fpc.patch ---
--- fpcsrc/compiler/cfileutils.pas 2007-05-27 12:52:15.000000000 +0200
+++ fpcsrc/compiler/cfileutils.pas 2007-10-04 14:13:49.000000000 +0200
@@ -50,11 +50,14 @@
TCachedDirectory = class(TFPHashObject)
private
FDirectoryEntries : TFPHashList;
+ procedure FreeDirectoryEntries;
+ function GetItemAttr(const AName: TCmdStr): byte;
public
constructor Create(AList:TFPHashObjectList;const AName:TCmdStr);
destructor destroy;override;
procedure Reload;
function FileExists(const AName:TCmdStr):boolean;
+ function FileExistsCaseAware(const AName:TCmdStr; out FoundName:
TCmdStr):boolean;
function DirectoryExists(const AName:TCmdStr):boolean;
property DirectoryEntries:TFPHashList read FDirectoryEntries;
end;
@@ -67,6 +70,12 @@
EntryIndex : longint;
end;
+ PCachedDirectoryEntry = ^TCachedDirectoryEntry;
+ TCachedDirectoryEntry = record
+ RealName: TCmdStr;
+ Attr : byte;
+ end;
+
TDirectoryCache = class
private
FDirectories : TFPHashObjectList;
@@ -75,6 +84,7 @@
constructor Create;
destructor destroy;override;
function FileExists(const AName:TCmdStr):boolean;
+ function FileExistsCaseAware(const AName:TCmdStr; out FoundName:
TCmdStr):boolean;
function DirectoryExists(const AName:TCmdStr):boolean;
function FindFirst(const APattern:TCmdStr;var
Res:TCachedSearchRec):boolean;
function FindNext(var Res:TCachedSearchRec):boolean;
@@ -136,29 +146,67 @@
destructor TCachedDirectory.destroy;
begin
+ FreeDirectoryEntries;
FDirectoryEntries.Free;
inherited destroy;
end;
+ procedure TCachedDirectory.FreeDirectoryEntries;
+ var
+ i: Integer;
+ begin
+ if not(tf_files_case_aware in source_info.flags) then
+ exit;
+ for i := 0 to DirectoryEntries.Count-1 do
+ dispose(PCachedDirectoryEntry(DirectoryEntries[i]));
+ end;
+
+
+ function TCachedDirectory.GetItemAttr(const AName: TCmdStr): byte;
+ var
+ entry: PCachedDirectoryEntry;
+ begin
+ if not(tf_files_case_sensitive in source_info.flags) then
+ if (tf_files_case_aware in source_info.flags) then
+ begin
+
entry:=PCachedDirectoryEntry(DirectoryEntries.Find(Lower(AName)));
+ if assigned(entry) then
+ Result:=entry^.Attr
+ else
+ Result:=0;
+ end
+ else
+ Result:=PtrUInt(DirectoryEntries.Find(Lower(AName)))
+ else
+ Result:=PtrUInt(DirectoryEntries.Find(AName));
+ end;
+
+
procedure TCachedDirectory.Reload;
var
- dir : TSearchRec;
+ dir : TSearchRec;
+ entry : PCachedDirectoryEntry;
begin
+ FreeDirectoryEntries;
DirectoryEntries.Clear;
if findfirst(IncludeTrailingPathDelimiter(Name)+'*',faAnyFile or
faDirectory,dir) = 0 then
begin
repeat
if ((dir.attr and faDirectory)<>faDirectory) or
- (dir.Name<>'.') or
- (dir.Name<>'..') then
+ ((dir.Name<>'.') and
+ (dir.Name<>'..')) then
begin
- { Force Archive bit so the attribute always has a value.
This is needed
- to be able to see the difference in the directoryentries
lookup if a file
- exists or not }
- Dir.Attr:=Dir.Attr or faArchive;
if not(tf_files_case_sensitive in source_info.flags) then
-
DirectoryEntries.Add(Lower(Dir.Name),Pointer(Ptrint(Dir.Attr)))
+ if (tf_files_case_aware in source_info.flags) then
+ begin
+ new(entry);
+ entry^.RealName:=Dir.Name;
+ entry^.Attr:=Dir.Attr;
+ DirectoryEntries.Add(Lower(Dir.Name),entry)
+ end
+ else
+
DirectoryEntries.Add(Lower(Dir.Name),Pointer(Ptrint(Dir.Attr)))
else
DirectoryEntries.Add(Dir.Name,Pointer(Ptrint(Dir.Attr)));
end;
@@ -172,10 +220,7 @@
var
Attr : Longint;
begin
- if not(tf_files_case_sensitive in source_info.flags) then
- Attr:=PtrInt(DirectoryEntries.Find(Lower(AName)))
- else
- Attr:=PtrInt(DirectoryEntries.Find(AName));
+ Attr:=GetItemAttr(AName);
if Attr<>0 then
Result:=((Attr and faDirectory)=0)
else
@@ -183,14 +228,37 @@
end;
+ function TCachedDirectory.FileExistsCaseAware(const AName:TCmdStr; out
FoundName: TCmdStr):boolean;
+ var
+ entry : PCachedDirectoryEntry;
+ Attr : Longint;
+ begin
+ if (tf_files_case_aware in source_info.flags) then
+ begin
+ entry:=PCachedDirectoryEntry(DirectoryEntries.Find(Lower(AName)));
+ if assigned(entry) then
+ begin
+ Attr:=entry^.Attr;
+ FoundName:=entry^.RealName
+ end
+ else
+ Attr:=0;
+ if Attr<>0 then
+ Result:=((Attr and faDirectory)=0)
+ else
+ Result:=false
+ end
+ else
+ { should not be called in this case, use plain FileExists }
+ Result:=False;
+ end;
+
+
function TCachedDirectory.DirectoryExists(const AName:TCmdStr):boolean;
var
Attr : Longint;
begin
- if not(tf_files_case_sensitive in source_info.flags) then
- Attr:=PtrInt(DirectoryEntries.Find(Lower(AName)))
- else
- Attr:=PtrInt(DirectoryEntries.Find(AName));
+ Attr:=GetItemAttr(AName);
if Attr<>0 then
Result:=((Attr and faDirectory)=faDirectory)
else
@@ -246,6 +314,21 @@
end;
+ function TDirectoryCache.FileExistsCaseAware(const AName:TCmdStr; out
FoundName:TCmdStr):boolean;
+ var
+ CachedDir : TCachedDirectory;
+ begin
+ Result:=false;
+ CachedDir:=GetDirectory(ExtractFileDir(AName));
+ if assigned(CachedDir) then
+ begin
+
Result:=CachedDir.FileExistsCaseAware(ExtractFileName(AName),FoundName);
+ if Result then
+ FoundName:=ExtractFilePath(AName)+FoundName;
+ end;
+ end;
+
+
function TDirectoryCache.DirectoryExists(const AName:TCmdStr):boolean;
var
CachedDir : TCachedDirectory;
@@ -270,11 +353,22 @@
function TDirectoryCache.FindNext(var Res:TCachedSearchRec):boolean;
+ var
+ entry: PCachedDirectoryEntry;
begin
if Res.EntryIndex<Res.CachedDir.DirectoryEntries.Count then
begin
-
Res.Name:=Res.CachedDir.DirectoryEntries.NameOfIndex(Res.EntryIndex);
- Res.Attr:=PtrInt(Res.CachedDir.DirectoryEntries[Res.EntryIndex]);
+ if (tf_files_case_aware in source_info.flags) then
+ begin
+ entry:=Res.CachedDir.DirectoryEntries[Res.EntryIndex];
+ Res.Name:=entry^.RealName;
+ Res.Attr:=entry^.Attr;
+ end
+ else
+ begin
+
Res.Name:=Res.CachedDir.DirectoryEntries.NameOfIndex(Res.EntryIndex);
+
Res.Attr:=PtrUInt(Res.CachedDir.DirectoryEntries[Res.EntryIndex]);
+ end;
inc(Res.EntryIndex);
Result:=true;
end
@@ -422,11 +516,24 @@
1. NormalCase
}
FoundFile:=path+fn;
- If FileExists(FoundFile,allowcache) then
- begin
- result:=true;
- exit;
- end;
+{$ifdef usedircache}
+ if allowcache then
+ begin
+ result:=DirCache.FileExistsCaseAware(FoundFile,fn2);
+ if result then
+ begin
+ FoundFile:=fn2;
+ exit;
+ end;
+ end
+ else
+{$endif usedircache}
+ If FileExists(FoundFile,allowcache) then
+ begin
+ { don't know the real name in this case }
+ result:=true;
+ exit;
+ end;
end
else
begin
@@ -1007,7 +1114,7 @@
while (pc^<>sepch) and (pc^<>';') and (pc^<>#0) do
inc(pc);
SetLength(singlepathstring, pc-startpc);
- move(startpc^,singlepathstring[1],pc-startpc);
+ move(startpc^,singlepathstring[1],pc-startpc);
singlepathstring:=FixPath(ExpandFileName(singlepathstring),false);
result:=FileExistsNonCase(singlepathstring,f,allowcache,FoundFile);
if result then
Index: fpc.info
===================================================================
RCS file: /cvsroot/fink/dists/10.4/unstable/main/finkinfo/languages/fpc.info,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- fpc.info 17 Oct 2007 22:42:11 -0000 1.5
+++ fpc.info 6 Nov 2007 18:52:05 -0000 1.6
@@ -1,8 +1,9 @@
Package: fpc
Version: 2.2.0
-Revision: 2
+Revision: 3
Architecture: powerpc, i386
-Distribution: 10.4
+BuildDepends: fink (>= 0.24.12)
+# Reason for fink (>= 0.24.12): Use of PatchFile: field
Recommends: fpc-doc
CustomMirror: <<
aus-AU: http://fpc.planetmirror.com/pub/fpc/
@@ -17,9 +18,11 @@
<<
Source: mirror:custom:dist/%v/source/fpcbuild-%v.tar.gz
Source-MD5: 0869cfd07d012b702ff08c0a4196624b
-Source2: mirror:custom:dist/%v/source/fpc-%v.universal-darwin.bootstrap.tar.bz2
-Source2-MD5: a1bec63825522d1f7a5af80f4fa102a4
+Source2:
mirror:custom:dist/%v/source/fpc-%v-2.universal-darwin.bootstrap.tar.bz2
+Source2-MD5: aad6102fe1a773ea1d0b8e7c1b05f828
SourceDirectory: fpcbuild-%v/fpcsrc
+PatchFile: %n.patch
+PatchFile-MD5: 08facd944cdf940250e8d987bf6af682
Patchscript: <<
#!/bin/sh -ev
# The patch resolves a bug, when ginstall is used instead of install
@@ -33,6 +36,9 @@
# So, any higher version than 2.2.0 should not need this patch script.
sed -i.bak 's|variants types sysctl dateutils|variants dateutils|g'
rtl/darwin/Makefile.fpc
sed -i.bak 's|variants types sysctl dateutils|variants dateutils|g'
rtl/darwin/Makefile
+# mv compiler/cfileutils.pas compiler/cfileutils.orig.pas
+# sed 's|@PREFIX@|%p|g' < %{PatchFile} | patch -p1
+ patch -p1 < %{PatchFile}
<<
CompileScript: <<
#!/bin/sh -ev
@@ -82,10 +88,7 @@
This Pascal compiler produces PowerPC and x86 executables, which run natively
on PowerPC and x86 Macs. PowerPC executables also runs in Rosetta emulation
on x86 Macs.
- BEWARE: On case sensitive file systems, fpc does not work, yet.
- Until the next revision, please use a svn version from
http://www.freepascal.org/
- Universal Binaries:
- Use lipo to combine PowerPC and x86 binaries.
+ Use lipo to combine PowerPC and x86 binaries to universal binaries.
get help with: fpc -?
compile and link a Pascal file with: fpc FILENAME
For setting up the Free Pascal IDE see:
@@ -95,7 +98,6 @@
For more documentation about Free Pascal in HTML and pdf, install fpc-doc
<<
DescPort: <<
- The bug with case sensitive file systems needs to be fixed (cfileutils.pas).
Nothing special, yet. ToDo: lazarus, universal binaries and extra package
with dependent C libraries (gtk ...) .
<<
-------------------------------------------------------------------------
This SF.net email is sponsored by: Splunk Inc.
Still grepping through log files to find problems? Stop.
Now Search log events and configuration files using AJAX and a browser.
Download your FREE copy of Splunk now >> http://get.splunk.com/
_______________________________________________
Fink-commits mailing list
Fink-commits@lists.sourceforge.net
http://news.gmane.org/gmane.os.apple.fink.cvs
