From 8c3bf494d01de34a23b4eb0337ee7a5d4e07ebd9 Mon Sep 17 00:00:00 2001 From: irwin Date: Mon, 6 Apr 2026 17:48:49 +0200 Subject: [PATCH 1/2] Implementation of DIR/DIRECTORY command with output parity --- src/Common/FoxProCmd.xh | 5 +- src/Runtime/XSharp.VFP.Tests/CommandTests.prg | 94 ++++++++++++ .../XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj | 1 + src/Runtime/XSharp.VFP/Commands.prg | 142 ++++++++++++++++++ 4 files changed, 241 insertions(+), 1 deletion(-) create mode 100644 src/Runtime/XSharp.VFP.Tests/CommandTests.prg diff --git a/src/Common/FoxProCmd.xh b/src/Common/FoxProCmd.xh index b16c50a4ed..72def21efa 100644 --- a/src/Common/FoxProCmd.xh +++ b/src/Common/FoxProCmd.xh @@ -156,8 +156,11 @@ [<.bin.>], [<"coll">], [<.cand.>], [<.cmp.>] ) ;; ; OrdCreate(<(file)>,<(ORDER)>,<(key)>,,IIF(<.u.>,.T., NIL)) +#command DIR <*any*> => __VfpDir( <"any"> ) +#command DIRECTORY <*any*> => __VfpDir( <"any"> ) - +#command DIR => __VfpDir( "" ) +#command DIRECTORY => __VfpDir( "" ) // Commands with IN clause, commands without are defined in DBCMD.XH diff --git a/src/Runtime/XSharp.VFP.Tests/CommandTests.prg b/src/Runtime/XSharp.VFP.Tests/CommandTests.prg new file mode 100644 index 0000000000..d797cfb9c3 --- /dev/null +++ b/src/Runtime/XSharp.VFP.Tests/CommandTests.prg @@ -0,0 +1,94 @@ +// +// Copyright (c) XSharp B.V. All Rights Reserved. +// Licensed under the Apache License, Version 2.0. +// See License.txt in the project root for license information. +// + +USING System +USING System.Collections.Generic +USING System.Text +USING System.IO +USING XUnit + +BEGIN NAMESPACE XSharp.VFP.Tests + + CLASS CommandTests + STATIC CONSTRUCTOR + XSharp.RuntimeState.Dialect := XSharpDialect.FoxPro + END CONSTRUCTOR + + [Fact]; + METHOD TestDirFullSuite() AS VOID + LOCAL cOldDir AS STRING + LOCAL cTempPath AS STRING + LOCAL cOutFile AS STRING + LOCAL cContent AS STRING + cOldDir := Directory.GetCurrentDirectory() + + local oDir as DirectoryInfo + oDir := Directory.CreateDirectory(Path.Combine(Path.GetTempPath(), "DirTest_" + Guid.NewGuid():ToString("N"))) + cTempPath := oDir:FullName + + Assert.True(Directory.Exists(cTempPath)) + + TRY + SET DEFAULT TO (cTempPath) + + CREATE TABLE NormalTest (Id INT, Name CHAR(20)) + INSERT INTO NormalTest VALUES (1, "John") + INSERT INTO NormalTest VALUES (2, "Peter") + + CREATE TABLE this_is_a_table_with_a_long_name (Id INT) + + File.WriteAllText(Path.Combine(cTempPath, "Readme.txt"), "Test content") + File.WriteAllText(Path.Combine(cTempPath, "NoExtensionFile"), "No extension") + + XSharp.CoreDb.CloseAll() + + cOutFile := Path.GetTempFileName() + LOCAL lcFileVar := cOutFile AS STRING + + DIR *.dbf TO FILE (lcFileVar) + cContent := File.ReadAllText(cOutFile) + Assert.True(cContent:Contains("NORMALTEST.DBF")) + Assert.True(cContent:Contains("2")) + Assert.True(cContent:Contains("Database Table/DBF files")) + + DIR *. TO FILE (lcFileVar) + cContent := File.ReadAllText(cOutFile) + Assert.True(cContent:Contains("NOEXTENSIONFILE")) + + DIR LIKE *.* TO FILE (lcFileVar) + cContent := File.ReadAllText(cOutFile) + Assert.True(cContent:Contains("README.TXT")) + Assert.True(cContent:Contains("files found.")) + + DIR TO FILE (lcFileVar) + cContent := File.ReadAllText(cOutFile) + Assert.True(cContent:Contains("NORMALTEST.DBF")) + + LOCAL lcSubFolder := "SubTest" AS STRING + Directory.CreateDirectory(Path.Combine(cTempPath, lcSubFolder)) + + DIR (lcSubFolder + "\*.dbf") TO FILE (lcFileVar) + cContent := File.ReadAllText(cOutFile) + Assert.True(cContent:Contains("No matching files found.")) + + FINALLY + XSharp.CoreDb.CloseAll() + SET DEFAULT TO (cOldDir) + Directory.SetCurrentDirectory(cOldDir) + + IF File.Exists(cOutFile) + File.Delete(cOutFile) + ENDIF + + IF Directory.Exists(cTempPath) + Directory.Delete(cTempPath, TRUE) + ENDIF + END TRY + RETURN + + END CLASS + +END NAMESPACE diff --git a/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj b/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj index 407781bd39..846b21cb8c 100644 --- a/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj +++ b/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj @@ -93,6 +93,7 @@ + diff --git a/src/Runtime/XSharp.VFP/Commands.prg b/src/Runtime/XSharp.VFP/Commands.prg index 06d43fe506..6717c4c6af 100644 --- a/src/Runtime/XSharp.VFP/Commands.prg +++ b/src/Runtime/XSharp.VFP/Commands.prg @@ -4,6 +4,13 @@ // See License.txt in the project root for license information. // +USING System +USING System.IO +USING System.Text +USING System.Collections.Generic +USING XSharp.RT +USING XSharp.Internal + /// FUNCTION _cmdDirMake(cDir as STRING) AS VOID System.IO.Directory.CreateDirectory(cDir) @@ -16,4 +23,139 @@ FUNCTION _cmdDirChange(cDir as STRING) AS VOID FUNCTION _cmdDirRemove(cDir as STRING) AS VOID System.IO.Directory.Delete(cDir,false) +[NeedsAccessToLocals(TRUE)]; +FUNCTION __VfpDir(cCommand AS STRING) AS VOID + LOCAL cSkeleton AS STRING + LOCAL cToFile AS STRING + LOCAL lToPrinter AS LOGIC + LOCAL nPos AS INT + + cCommand := cCommand:Trim() + cSkeleton := cCommand + cToFile := "" + lToPrinter := .F. + + nPos := cCommand:IndexOf(" TO FILE ", StringComparison.OrdinalIgnoreCase) + IF nPos >= 0 + cSkeleton := cCommand:Substring(0, nPos):Trim() + cToFile := cCommand:Substring(nPos + 9):Trim() + ELSE + nPos := cCommand:IndexOf(" TO PRINTER", StringComparison.OrdinalIgnoreCase) + IF nPos >= 0 + cSkeleton := cCommand:Substring(0, nPos):Trim() + lToPrinter := .T. + ENDIF + ENDIF + + IF cSkeleton:StartsWith("(") .AND. cSkeleton:EndsWith(")") + TRY + cSkeleton := (STRING) Evaluate(cSkeleton:Substring(1, cSkeleton:Length - 2)) + CATCH + NOP + END TRY + ENDIF + + IF !String.IsNullOrEmpty(cToFile) + IF cToFile:StartsWith("(") .AND. cToFile:EndsWith(")") + TRY + cToFile := (STRING) Evaluate(cToFile:Substring(1, cToFile:Length - 2)) + CATCH + cToFile := cToFile:Replace(c'"':ToString(), ""):Replace(c'''':ToString(), "") + END TRY + ELSE + cToFile := cToFile:Replace(c'"':ToString(), ""):Replace(c'''':ToString(), "") + ENDIF + ENDIF + + IF cSkeleton:StartsWith("LIKE ", StringComparison.OrdinalIgnoreCase) + cSkeleton := cSkeleton:Substring(5):Trim() + ELSEIF cSkeleton:StartsWith("ON ", StringComparison.OrdinalIgnoreCase) + LOCAL cDrive := cSkeleton:Substring(3):Trim() AS STRING + IF cDrive:Length == 1 ; cSkeleton := cDrive + ":\*.dbf" ; ENDIF + ENDIF + + LOCAL cPath := "" AS STRING + LOCAL cPattern := "" AS STRING + + IF String.IsNullOrEmpty(cSkeleton) .OR. cSkeleton == "*" + cPath := Directory.GetCurrentDirectory() + cPattern := "*.dbf" + ELSE + IF Directory.Exists(cSkeleton) + cPath := cSkeleton + cPattern := "*.dbf" + ELSE + TRY + cPath := Path.GetDirectoryName(cSkeleton) + cPattern := Path.GetFileName(cSkeleton) + CATCH + cPath := "" + cPattern := cSkeleton + END TRY + IF String.IsNullOrEmpty(cPath) ; cPath := Directory.GetCurrentDirectory() ; ENDIF + IF String.IsNullOrEmpty(cPattern) ; cPattern := "*.dbf" ; ENDIF + ENDIF + ENDIF + + LOCAL aFiles AS STRING[] + TRY + aFiles := Directory.GetFiles(cPath, cPattern) + CATCH + aFiles := STRING[]{0} + END TRY + + LOCAL sb := StringBuilder{} AS StringBuilder + + IF aFiles:Length == 0 + sb:AppendLine("No matching files found.") + ELSE + IF cPattern:EndsWith(".dbf", StringComparison.OrdinalIgnoreCase) + sb:AppendLine(String.Format("{0,-32} {1,10} {2,20} {3,15}", "Database Table/DBF files", "# Records", "Last Update", "Size")) + LOCAL nTotalBytes := 0 AS INT64 + FOREACH cFile AS STRING IN aFiles + LOCAL oInfo := FileInfo{cFile} AS FileInfo + LOCAL nRecs := 0 AS INT + LOCAL cDate := "" AS STRING + TRY + USING VAR fs := FileStream{cFile, FileMode.Open, FileAccess.Read, FileShare.ReadWrite} + USING VAR br := BinaryReader{fs} + br:ReadByte() + LOCAL y := br:ReadByte() AS BYTE, m := br:ReadByte() AS BYTE, d := br:ReadByte() AS BYTE + nRecs := br:ReadInt32() + cDate := String.Format("{0:D2}/{1:D2}/{2:D2}", m, d, y % 100) + CATCH + cDate := oInfo:LastWriteTime:ToString("MM/dd/yy") + END TRY + + IF oInfo:Name:Length > 25 + sb:AppendLine(oInfo:Name:ToUpper()) + sb:AppendLine(String.Format("{0,43} {1,20} {2,15}", nRecs, cDate, oInfo:Length)) + ELSE + sb:AppendLine(String.Format("{0,-32} {1,10} {2,20} {3,15}", oInfo:Name:ToUpper(), nRecs, cDate, oInfo:Length)) + ENDIF + nTotalBytes += oInfo:Length + NEXT + sb:AppendLine("") + sb:AppendLine(String.Format("{0} bytes in {1} files.", nTotalBytes, aFiles:Length)) + ELSE + sb:AppendLine("Directory of " + cPath + "\" + cPattern) + sb:AppendLine("") + LOCAL nCol := 0 AS INT + FOREACH cFile AS STRING IN aFiles + sb:Append(String.Format("{0,-16}", Path.GetFileName(cFile):ToUpper())) + nCol++ + IF nCol >= 4 ; sb:AppendLine() ; nCol := 0 ; ENDIF + NEXT + IF nCol > 0 ; sb:AppendLine() ; ENDIF + sb:AppendLine("") + sb:AppendLine(String.Format("{0,10} files found.", aFiles:Length)) + ENDIF + ENDIF + LOCAL cRes := sb:ToString() AS STRING + IF !String.IsNullOrEmpty(cToFile) + File.WriteAllText(cToFile, cRes) + ELSE + QOut(cRes) + ENDIF +RETURN From e550334571a2fa4b0faddfdb6182a77f92d9ffe7 Mon Sep 17 00:00:00 2001 From: irwin Date: Mon, 6 Apr 2026 19:17:55 +0200 Subject: [PATCH 2/2] Set NeedsAccessToLocals to FALSE (read-only access) --- src/Runtime/XSharp.VFP/Commands.prg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Runtime/XSharp.VFP/Commands.prg b/src/Runtime/XSharp.VFP/Commands.prg index 6717c4c6af..faacd9ffdf 100644 --- a/src/Runtime/XSharp.VFP/Commands.prg +++ b/src/Runtime/XSharp.VFP/Commands.prg @@ -23,7 +23,7 @@ FUNCTION _cmdDirChange(cDir as STRING) AS VOID FUNCTION _cmdDirRemove(cDir as STRING) AS VOID System.IO.Directory.Delete(cDir,false) -[NeedsAccessToLocals(TRUE)]; +[NeedsAccessToLocals(FALSE)]; FUNCTION __VfpDir(cCommand AS STRING) AS VOID LOCAL cSkeleton AS STRING LOCAL cToFile AS STRING