Some changes in preparation for a patch (#1687)

* SqlRdd updates

* [Compiler] Simplified Keyword Rule (no need for separate rules for Base, Xpp, Fox). These is now a single rule for "soft" keywords.
Added ThisForm keyword for FoxPro.  The detection and translation is done in the TransformationFox. The implementation of the FindForm() call is inside the code that also handles Clipper arguments and PSZs inside TransformationRT.
See https://www.xsharp.eu/forum/topic/5213

* [Tests] Adjust tests to work with X# 3:
- Added method FindForm() for code that uses ThisForm
- Cannot use .cs extension for source file
- Disable an extra warning
-

* [Compiler tests] Added C934 for #1673

* [Compiler tests] Added C935 for #1677

* [XGui] Suppress wndproc because current code disables mouse move messages on fixed text controls

* [Compiler] Fix for C935 and #1677 . The hascode is now calculated for the full filename including the path. Previously the hashcode was for the path only.

* [Runtime] Added 2 functions (ASortFunc and ASortEx) to handle comparisons with duplicates better.

* Fix for #1685 . Allow * comment lines to continue to the next line when the last non whitespace character is a semicolon.

* [Runtime] Some changes to Asort() to handle duplicate elements, especially for multi dimensional arrays

* Fix for #1686 . Added Delegate in the RuntimeState that gets called when an error occurs in the MacroCompiler. You can return a compile time codeblock, or a runtime codeblock created with MCompile().

* [Runtime] Improve performance of the __IsFoxArray property in the Array class, by making it virtual and overriding it in XSharp.VFP.

---------

Co-authored-by: cpyrgas <[email protected]>

src/Compiler/src/Compiler/XSharpCodeAnalysis/Parser/XSharpLexerCode.cs

@@ -436,14 +436,33 @@ void parseFoxProDate()
             return;
         }
 
-        void parseToEol()
+        bool parseToEol()
         {
+            bool endsWithSemicolon = false;
             var la1 = La(1);
             while (la1 != EOF && la1 != '\r' && la1 != '\n')
             {
+                if (ExpectAny(' ', '\t'))
+                {
+                    ;// skip whitespace
+                }
+                else
+                {
+                    if (la1 == ';')
+                    {
+                        endsWithSemicolon = true;
+                    }
+                    else if (endsWithSemicolon)
+                    {
+                        // non whitespace after semicolon
+                        // will reset the endsWithSemicolon flag
+                        endsWithSemicolon = false;
+                    }
+                }
                 parseOne();
                 la1 = La(1);
             }
+            return endsWithSemicolon;
         }
 
         bool tryParseNewLine()
@@ -475,11 +494,21 @@ void parseWhitespace()
                 parseOne();
         }
 
-        void parseSlComment()
+        void parseSlComment(bool allowSemicolonContinue = false)
         {
             parseType(SL_COMMENT);
             _tokenChannel = TokenConstants.HiddenChannel;
-            parseToEol();
+            var endsWithSemicolon = parseToEol();
+            // FoxPro dialect allows * comments to continue on the next line when the line ends with a semicolon
+            if (Dialect == XSharpDialect.FoxPro && endsWithSemicolon && allowSemicolonContinue)
+            {
+                while (endsWithSemicolon)
+                {
+                    tryParseNewLine();
+                    parseType(SL_COMMENT);
+                    endsWithSemicolon = parseToEol();
+                }
+            }
         }
 
         void parseDocComment()
@@ -1186,7 +1215,7 @@ public override IToken NextToken()
                     case '*':
                         parseOne(MULT);
                         if (AllowOldStyleComments && StartOfLine(LastToken))
-                            parseSlComment();
+                            parseSlComment(allowSemicolonContinue: true);
                         else if (Expect('='))
                             parseOne(ASSIGN_MUL);
                         else if (Expect('*'))

src/Runtime/MacroCompiler.Example/VoTests.prg

@@ -694,10 +694,33 @@ BEGIN NAMESPACE MacroCompilerTest
         //typed and untyped parameters
         TestMacro(mc,"{|a,b| a + b }", Args(1,2), 3, typeof(INT))
         TestMacro(mc,"{|a as int,b as int| a + b }", Args(1,2), 3, typeof(INT))
+        RuntimeState.MacroCompilerErrorHandler := SubstituteErrorWithNil
+        TestMacro(mc, "{|| Left('abc,10) }", Args(),NULL, typeof(OBJECT))
+        RuntimeState.MacroCompilerErrorHandler := SubstituteErrorWithNilMacro
+        TestMacro(mc, "{|| 0h }", Args(),NULL, typeof(OBJECT))
+        TestMacro(mc, "{|| 0h1 }", Args(),NULL, typeof(OBJECT))
+        RuntimeState.MacroCompilerErrorHandler := NULL
+        TestMacro(mc, "{|| Left('abc,10) }", Args(),typeof(Exception),NULL, ErrorCode.UnterminatedString)
 
         Console.WriteLine("Total pass: {0}/{1}", TotalSuccess, TotalTests)
         RETURN
 
+        FUNCTION SubstituteErrorWithNil (cmacro as string, oEx as Exception) as ICodeblock
+            Console.WriteLine()
+            Console.WriteLine(i"Intercepted error in macro ""{cmacro}"" :")
+            Console.WriteLine(oEx:Message)
+            //Console.ReadLine()
+            return {|| NIL}
+
+        FUNCTION SubstituteErrorWithNilMacro (cmacro as string, oEx as Exception) as ICodeblock
+            //Console.ReadLine()
+            Console.WriteLine()
+            Console.WriteLine(i"Intercepted error in macro ""{cmacro}"" :")
+            Console.WriteLine(oEx:Message)
+            // Recursive, dangerous
+            return MCompile("NIL")
+
+
 END NAMESPACE
 
 

src/Runtime/MacroCompiler/Compiler/MacroCompiler.cs

@@ -106,6 +106,14 @@ public ICodeblock Compile(string macro, bool lAllowSingleQuotes, Module module,
             var m = compiler.Compile(macro);
             if (m.Diagnostic != null)
             {
+                if (RuntimeState.MacroCompilerErrorHandler != null)
+                {
+                    var result = RuntimeState.MacroCompilerErrorHandler(macro, m.Diagnostic);
+                    if (result != null)
+                    {
+                        return result;
+                    }
+                }
                 throw m.Diagnostic;
             }
             if (m.CreatesAutoVars)
@@ -123,6 +131,14 @@ public ICodeblock Compile(string macro)
             var m = compiler.Compile(macro);
             if (m.Diagnostic != null)
             {
+                if (RuntimeState.MacroCompilerErrorHandler != null)
+                {
+                    var result = RuntimeState.MacroCompilerErrorHandler(macro, m.Diagnostic);
+                    if (result != null)
+                    {
+                        return result;
+                    }
+                }
                 throw m.Diagnostic;
             }
             if (m.CreatesAutoVars)
@@ -138,6 +154,14 @@ public _Codeblock CompileCodeblock(string macro, bool lAllowSingleQuotes, Module
             var m = compiler.Compile(macro);
             if (m.Diagnostic != null)
             {
+                if (RuntimeState.MacroCompilerErrorHandler != null)
+                {
+                    var result = RuntimeState.MacroCompilerErrorHandler(macro, m.Diagnostic);
+                    if (result != null)
+                    {
+                        return new _Codeblock(result, macro, isCodeblock,false);
+                    }
+                }
                 throw m.Diagnostic;
             }
             if (m.CreatesAutoVars)
@@ -152,6 +176,14 @@ public _Codeblock CompileCodeblock(string macro)
             var m = compiler.Compile(macro);
             if (m.Diagnostic != null)
             {
+                if (RuntimeState.MacroCompilerErrorHandler != null)
+                {
+                    var result = RuntimeState.MacroCompilerErrorHandler(macro, m.Diagnostic);
+                    if (result != null)
+                    {
+                        return new _Codeblock(result, macro, true, false); ;
+                    }
+                }
                 throw m.Diagnostic;
             }
             if (m.CreatesAutoVars)

src/Runtime/XSharp.Core/State/State.prg

@@ -53,6 +53,7 @@ CLASS XSharp.RuntimeState
 	STATIC CONSTRUCTOR
         AutoLock        := NULL
         AutoUnLock      := NULL
+        MacroCompilerErrorHandler := NULL
         detectDialect()
         SWITCH System.Environment.OSVersion:Platform
         CASE System.PlatformID.Win32NT
@@ -1001,6 +1002,11 @@ CLASS XSharp.RuntimeState
             ENDIF
         END SET
     END PROPERTY
+
+    /// <summary>
+    /// You can register an error handler that will be called when the macrocompiler encounters an error
+    /// </summary>
+    PUBLIC STATIC PROPERTY MacroCompilerErrorHandler as MacroCompilerErrorHandler AUTO
 	/// <summary>This event is thrown when one of the codepages of the runtimestate is changed</summary>
     /// <remarks>Clients can refresh cached information by registering to this event</remarks>
     /// <seealso cref="DosCodePage" />

src/Runtime/XSharp.Core/Types/MacroSupport.prg

@@ -55,6 +55,21 @@ BEGIN NAMESPACE XSharp
     /// <seealso cref="SetMacroDuplicatesResolver"/>
     DELEGATE MacroCompilerResolveAmbiguousMatch(m1 AS MemberInfo, m2 AS MemberInfo, args AS System.Type[]) AS LONG
 
+    /// <summary>
+    /// You can register a function / method with this prototype in the RuntimeState to intercept errors in the macro compiler
+    /// </summary>
+    /// <param name="cMacro">Source of the macro that causes the error</param>
+    /// <param name="oEx">Exception describing the problem</param>
+    /// <returns>An object that implements ICodeblock, or NULL to tell the macro compiler to throw the error/</returns>
+    /// <remarks>
+    /// This delegate is called when the macro compiler encounters an error.
+    /// The delegate can decide to return a codeblock that will be used instead of the original codeblock
+    /// In theory you can 'patch' the cMacro and call the macro compiler again.
+    /// However that may cause an other error, resulting in an endless loop.
+    /// </remarks>
+    /// <seealso cref="ICodeblock"/>
+    DELEGATE MacroCompilerErrorHandler(cMacro as STRING, oEx as Exception) AS ICodeblock
+
     /// <summary>
 	/// This interface extends the Macro compiler and adds a method that is called to decide between ambigous methods or constructors
 	/// </summary>

src/Runtime/XSharp.RT.Tests/ArrayBaseTests.prg

@@ -8,13 +8,14 @@ USING System.Collections.Generic
 USING System.Linq
 USING System.Text
 USING XUnit
-
+using System.Diagnostics
 
 // Array tests are not working correctly yet with the current build
 BEGIN NAMESPACE XSharp.RT.Tests
 
     CLASS ArrayBaseTests
         // Normal non indexed developer
+        [DebuggerDisplay("{FirstName,nq} {LastName,nq}")];
         CLASS Developer
             PROPERTY FirstName AS STRING AUTO
             PROPERTY LastName AS STRING AUTO
@@ -26,6 +27,7 @@ BEGIN NAMESPACE XSharp.RT.Tests
 
         END CLASS
         // Special indexed developer
+        [DebuggerDisplay("{FirstName,nq} {LastName,nq}")];
         CLASS DeveloperIndexed INHERIT Developer IMPLEMENTS IIndexedProperties
             CONSTRUCTOR()
             CONSTRUCTOR (cFirst AS STRING, cLast AS STRING)
@@ -76,40 +78,46 @@ BEGIN NAMESPACE XSharp.RT.Tests
             aDevs := {}
             AADD(aDevs, Developer{"Chris","Pyrgas"})
             AADD(aDevs, Developer{"Nikos","Kokkalis"})
+            AADD(aDevs, Developer{"Robert","Van Der Hulst"})
+            AADD(aDevs, Developer{"Fabrice","Foray"})
             RETURN aDevs
         METHOD BuildIndexedArray() AS ARRAY OF DeveloperIndexed
             LOCAL aDevs AS ARRAY OF DeveloperIndexed
             aDevs := NULL_ARRAY
             aDevs := {}
             AADD(aDevs, DeveloperIndexed{"Chris","Pyrgas"})
             AADD(aDevs, DeveloperIndexed{"Nikos","Kokkalis"})
+            AADD(aDevs, DeveloperIndexed{"Robert","Van Der Hulst"})
+            AADD(aDevs, DeveloperIndexed{"Fabrice","Foray"})
             RETURN aDevs
         [Trait("Category", "ArrayBase")];
         [Fact];
         METHOD TestIndices AS VOID
             VAR aDevs := SELF:BuildArray()
-            Assert.Equal( 2 , (INT) ALen(aDevs))
+            Assert.Equal( 4 , (INT) ALen(aDevs))
             Assert.Equal("Chris", aDevs[1]:FirstName)
             Assert.Equal("Pyrgas", aDevs[1]:LastName)
+            Assert.Equal("Fabrice", aDevs[4]:FirstName)
+            Assert.Equal("Foray", aDevs[4]:LastName)
             Assert.Equal("Nikos", aDevs[2]:FirstName)
             Assert.Equal("Kokkalis", aDevs[2]:LastName)
             Assert.Equal("Chris", aDevs[1,"FirstName"])
             Assert.Equal("Pyrgas", aDevs[1,"LastName"])
             Assert.Equal("Nikos", aDevs[2,"FirstName"])
             Assert.Equal("Kokkalis", aDevs[2,"LastName"])
             Assert.ThrowsAny<Error>({ => aDevs[1,"First"] })
-            Assert.ThrowsAny<Error>({ => aDevs[3,"FirstName"] })
+            Assert.ThrowsAny<Error>({ => aDevs[5,"FirstName"] })
 
         [Trait("Category", "ArrayBase")];
         [Fact];
         METHOD TestSort AS VOID
             VAR aDevs := SELF:BuildArray()
             ASort(aDevs, {x, y => x:LastName <= y:LastName})
-            Assert.Equal("Kokkalis", aDevs[1]:LastName)
-            Assert.Equal("Pyrgas", aDevs[2]:LastName)
+            Assert.Equal("Kokkalis", aDevs[2]:LastName)
+            Assert.Equal("Pyrgas", aDevs[3]:LastName)
             ASort(aDevs, {x, y => x:FirstName <= y:FirstName})
             Assert.Equal("Chris", aDevs[1]:FirstName)
-            Assert.Equal("Nikos", aDevs[2]:FirstName)
+            Assert.Equal("Nikos", aDevs[3]:FirstName)
 
         [Trait("Category", "ArrayBase")];
         [Fact];
@@ -118,7 +126,7 @@ BEGIN NAMESPACE XSharp.RT.Tests
             LOCAL result AS STRING
             result := ""
             Aeval(aDevs, { x => result += x:FirstName})
-            Assert.Equal("ChrisNikos", result)
+            Assert.Equal("ChrisNikosRobertFabrice", result)
 
 
         [Trait("Category", "ArrayBase")];
@@ -127,7 +135,8 @@ BEGIN NAMESPACE XSharp.RT.Tests
             VAR aDevs := SELF:BuildArray()
             Assert.Equal(1, (INT) AScan(aDevs, { x => X:FirstName == "Chris" .AND. x:LastName == "Pyrgas"}))
             Assert.Equal(2, (INT) AScan(aDevs, { x => X:FirstName == "Nikos" .AND. x:LastName == "Kokkalis"}))
-            Assert.Equal(0, (INT) AScan(aDevs, { x => X:FirstName == "Fabrice" .AND. x:LastName == "Foray"}))
+            Assert.Equal(4, (INT) AScan(aDevs, { x => X:FirstName == "Fabrice" .AND. x:LastName == "Foray"}))
+            Assert.Equal(0, (INT) AScan(aDevs, { x => X:FirstName == "Bill" .AND. x:LastName == "Gates"}))
             VAR chris := aDevs[1]
             Assert.Equal(1, (INT) Ascan(adevs, chris))
 

src/Runtime/XSharp.RT.Tests/ArrayTests.prg

@@ -14,7 +14,49 @@ USING XUnit
 // Array tests are not working correctly yet with the current build
 BEGIN NAMESPACE XSharp.RT.Tests
 
-	CLASS ArrayTests
+
+    CLASS ArrayTests
+
+ 		[Trait("Category", "Array")];
+		[Fact];
+        METHOD AsortFuncTest() AS VOID
+            LOCAL FUNCTION SortFunc(a as usual,b as usual) AS INT
+                if upper(a) < upper(b)
+                    return -1
+                elseif upper(a) > upper(b)
+                    return 1
+                endif
+                return 0
+            END FUNCTION
+            LOCAL testArray AS ARRAY
+            testArray  := {"Fred", "Kate", "Fred", "ALVIN", "friend"}
+            ASortFunc(testArray, 1,ALen(testArray), SortFunc)
+            Assert.Equal(testArray[1],"ALVIN")
+            Assert.Equal(testArray[2],"Fred")
+            Assert.Equal(testArray[3],"Fred")
+            Assert.Equal(testArray[4],"friend")
+            Assert.Equal(testArray[5],"Kate")
+		RETURN
+    [Trait("Category", "Array")];
+    [Fact];
+     METHOD AsortExTest() AS VOID
+         LOCAL testArray AS ARRAY
+         testArray  := {"Fred", "Kate", "Fred", "ALVIN", "friend"}
+         // Use multi line codeblock feature below
+         ASortEx(testArray, 1,ALen(testArray), {|a,b|
+             if upper(a) < upper(b)
+                 return -1
+             elseif upper(a) > upper(b)
+                 return 1
+             endif
+             return 0
+            })
+         Assert.Equal(testArray[1],"ALVIN")
+         Assert.Equal(testArray[2],"Fred")
+         Assert.Equal(testArray[3],"Fred")
+         Assert.Equal(testArray[4],"friend")
+         Assert.Equal(testArray[5],"Kate")
+         RETURN
 
  		[Trait("Category", "Array")];
 		[Fact];
@@ -159,10 +201,11 @@ BEGIN NAMESPACE XSharp.RT.Tests
 			Assert.Equal( 0, (INT) a[1])
 			Assert.Equal( 8, (INT) a[6])
 
-			a := {8,2,1,4,3,0}
+			a := {8,2,1,4,3,0,8}
 			ASort(a , 0 , 100)
 			Assert.Equal( 0, (INT) a[1])
-			Assert.Equal( 8, (INT) a[6])
+            Assert.Equal( 8, (INT) a[6])
+            Assert.Equal( 8, (INT) a[7])
 
 			a := {8,2,1,4,3,0}
 			ASort(a , 0 , 100,IntegerSorter{})
@@ -173,14 +216,23 @@ BEGIN NAMESPACE XSharp.RT.Tests
 			Assert.Equal( 0, (INT) a[6])
 			Assert.Equal( 8, (INT) a[1])
 
-            a := {{ 1,1}, {1,2}, {2,3}, {2,4}}
+            a := {{ 1,1}, {2,3}, {1,2}, {2,4}}
             ASort(a, 0, 4, {|x,y| IIF (x[1] == y[1], x[2] <= y[2], x[1] < y[1])})
 
 			Assert.Equal( 1, (INT) a[1,2])
 			Assert.Equal( 2, (INT) a[2,2])
 			Assert.Equal( 3, (INT) a[3,2])
 			Assert.Equal( 4, (INT) a[4,2])
 
+            a := {{ 1,1}, {2,3}, {1,2}, {2,4}}
+            ASort(a, 0, 4, {|x,y| x[1] <= y[1]})
+
+			Assert.Equal( 1, (INT) a[1,2])
+			Assert.Equal( 2, (INT) a[2,2])
+			Assert.Equal( 3, (INT) a[3,2])
+			Assert.Equal( 4, (INT) a[4,2])
+
+
 
 		[Trait("Category", "Array")];
 		[Fact];