fcl-passrc: resolver: allow passing a string/char to an array of char

git-svn-id: trunk@45293 -

packages/fcl-passrc/src/pasresolver.pp

@@ -2,7 +2,7 @@
     This file is part of the Free Component Library
 
     Pascal resolver
-    Copyright (c) 2019  Mattias Gaertner  [email protected]
+    Copyright (c) 2020  Mattias Gaertner  [email protected]
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -25646,9 +25646,19 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
 
   procedure CheckRange(ArrType: TPasArrayType; RangeIndex: integer;
     Values: TPasResolverResult; ErrorEl: TPasElement);
+  var
+    ElTypeResolved: TPasResolverResult;
+
+    procedure CheckArrOfCharAssignString;
+    begin
+      ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
+      if ElTypeResolved.BaseType in btAllChars then
+        Result:=cTypeConversion; // ArrOfChar:=aString
+    end;
+
   var
     Range, Value, Expr: TPasExpr;
-    RangeResolved, ValueResolved, ElTypeResolved: TPasResolverResult;
+    RangeResolved, ValueResolved: TPasResolverResult;
     i, ExpectedCount, ValCnt: Integer;
     IsLastRange, IsConstExpr: Boolean;
     ArrayValues: TPasExprArray;
@@ -25752,19 +25762,18 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
     ExpectedCount:=-1;
     if length(ArrType.Ranges)=0 then
       begin
-      // dynamic array
+      // dynamic or open array
       if (Expr<>nil) then
         begin
         if Expr.ClassType=TArrayValues then
           ExpectedCount:=length(TArrayValues(Expr).Values)
         else if (Expr.ClassType=TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
           ExpectedCount:=length(TParamsExpr(Expr).Params)
-        else if (Values.BaseType in btAllStringAndChars) and IsVarInit(Expr) then
+        else if (Values.BaseType in btAllStringAndChars) then
           begin
-          // const a: dynarray = string
-          ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
-          if ElTypeResolved.BaseType in btAllChars then
-            Result:=cExact;
+          // e.g. const a: dynarray = string
+          // or e.g. pass a string literal to an open array
+          CheckArrOfCharAssignString;
           exit;
           end
         else
@@ -25777,7 +25786,15 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
         begin
         // type check
         if (Values.BaseType<>btContext) or (Values.LoTypeEl.ClassType<>TPasArrayType) then
+          begin
+          // RHS is not an array
+          if (Values.BaseType in btAllStringAndChars) then
+            begin
+            // e.g. pass a string literal to an open array
+            CheckArrOfCharAssignString;
+            end;
           exit;
+          end;
         RArrayType:=TPasArrayType(Values.LoTypeEl);
         if length(RArrayType.Ranges)>0 then
           begin

packages/fcl-passrc/tests/tcresolver.pas

@@ -780,6 +780,7 @@ type
     Procedure TestStaticArrayOfChar;
     Procedure TestStaticArrayOfCharDelphi;
     Procedure TestStaticArrayOfRangeElCheckFail;
+    Procedure TestArrayOfChar_String;
     Procedure TestArrayOfArray;
     Procedure TestArrayOfArray_NameAnonymous;
     Procedure TestFunctionReturningArray;
@@ -814,6 +815,7 @@ type
     Procedure TestArray_OpenArrayAsDynArray;
     Procedure TestArray_OpenArrayDelphi;
     Procedure TestArray_OpenArrayChar;
+    Procedure TestArray_DynArrayChar;
     Procedure TestArray_CopyConcat;
     Procedure TestStaticArray_CopyConcat;// ToDo
     Procedure TestArray_CopyMismatchFail;
@@ -14193,6 +14195,25 @@ begin
     'range check error while evaluating constants (300 is not between -128 and 127)');
 end;
 
+procedure TTestResolver.TestArrayOfChar_String;
+begin
+  StartProgram(false);
+  Add([
+  'procedure {#a}Run(const s: string); overload;',
+  'begin end;',
+  'procedure {#b}Run(const a: array of char); overload;',
+  'begin end;',
+  'var',
+  '  s: string;',
+  '  c: char;',
+  'begin',
+  '  {@a}Run(''foo'');',
+  '  {@a}Run(s);',
+  '  {@a}Run(c);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestArrayOfArray;
 begin
   StartProgram(false);
@@ -14858,6 +14879,26 @@ begin
   'var Key: Char;',
   'begin',
   '  if CharInSet(Key, [^V, ^X, ^C]) then ;',
+  '  CharInSet(Key,''abc'');',
+  '  CharInSet(Key,Key);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArray_DynArrayChar;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type TArrChr = array of char;',
+  'var',
+  '  Key: Char;',
+  '  s: string;',
+  '  a: TArrChr;',
+  'begin',
+  '  a:=''Foo'';',
+  '  a:=Key;',
+  '  a:=s;',
   '']);
   ParseProgram;
 end;