fcl-passrc: resolver: mode delphi: allow passing static array to openarray

git-svn-id: trunk@39308 -

packages/fcl-passrc/src/pasresolver.pp

@@ -17161,7 +17161,19 @@ function TPasResolver.GetTypeDescription(aType: TPasType; AddPath: boolean): str
   begin
     Result:=aType.Name;
     if Result='' then
-      Result:=GetElementTypeName(aType);
+      begin
+      if aType is TPasArrayType then
+        begin
+        if length(TPasArrayType(aType).Ranges)>0 then
+          Result:='static array'
+        else if IsOpenArray(aType) then
+          Result:='open array'
+        else
+          Result:='dynamic array';
+        end
+      else
+        Result:=GetElementTypeName(aType);
+      end;
     if AddPath then
       begin
       s:=aType.ParentPath;
@@ -17566,14 +17578,17 @@ begin
         // DynOrOpenArr:=MultiDimStaticArr  -> no
         if RaiseOnIncompatible then
           RaiseIncompatibleTypeDesc(20180620115235,nIncompatibleTypesGotExpected,
-            [],'static array','dynamic array',ErrorEl);
+            [],'multi dimensional static array','dynamic array',ErrorEl);
         exit(cIncompatible);
         end
       else if length(RArray.Ranges)>0 then
         begin
         // DynOrOpenArr:=SingleDimStaticArr
-        if msDelphi in CurrentParser.CurrentModeswitches then
+        if (msDelphi in CurrentParser.CurrentModeswitches)
+            and not IsOpenArray(LArray) then
           begin
+          // DynArr:=SingleDimStaticArr  forbidden in Delphi
+          // Note: OpenArr:=StaticArr is allowed in Delphi
           if RaiseOnIncompatible then
             RaiseIncompatibleTypeDesc(20180620115341,nIncompatibleTypesGotExpected,
               [],'static array','dynamic array',ErrorEl);

packages/fcl-passrc/tests/tcresolver.pas

@@ -702,6 +702,7 @@ type
     Procedure TestArrayEnumCustomRange;
     Procedure TestArray_DynArrayConstObjFPC;
     Procedure TestArray_DynArrayConstDelphi;
+    Procedure TestArray_DynArrAssignStaticDelphiFail;
     Procedure TestArray_Static_Const;
     Procedure TestArray_Record_Const;
     Procedure TestArray_MultiDim_Const;
@@ -714,6 +715,7 @@ type
     Procedure TestArray_OpenArrayOverride;
     Procedure TestArray_OpenArrayAsDynArraySetLengthFail;
     Procedure TestArray_OpenArrayAsDynArray;
+    Procedure TestArray_OpenArrayDelphi;
     Procedure TestArray_CopyConcat;
     Procedure TestStaticArray_CopyConcat;// ToDo
     Procedure TestArray_CopyMismatchFail;
@@ -12196,6 +12198,22 @@ begin
   CheckResolverUnexpectedHints;
 end;
 
+procedure TTestResolver.TestArray_DynArrAssignStaticDelphiFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TIntArr = array[1..3] of longint;',
+  'var',
+  '  dyn: array of longint;',
+  '  sta: TIntArr;',
+  'begin',
+  '  dyn:=sta;']);
+  CheckResolverException('Incompatible types: got "static array" expected "dynamic array"',
+    nIncompatibleTypesGotExpected);
+end;
+
 procedure TTestResolver.TestArray_Static_Const;
 begin
   StartProgram(false);
@@ -12276,7 +12294,7 @@ begin
   Add('  a: array[TEnum] of longint;');
   Add('begin');
   Add('  a:=nil;');
-  CheckResolverException('Incompatible types: got "Nil" expected "array"',
+  CheckResolverException('Incompatible types: got "Nil" expected "static array"',
     nIncompatibleTypesGotExpected);
 end;
 
@@ -12419,6 +12437,30 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestArray_OpenArrayDelphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TDynArrInt = array of byte;',
+  '  TStaArrInt = array[1..2] of byte;',
+  'procedure DoIt(a: array of byte);',
+  'var',
+  '  d: TDynArrInt;',
+  '  s: TStaArrInt;',
+  'begin',
+  '  DoIt(a);',
+  '  // d:=s; forbidden in delphi', // see TestArray_DynArrAssignStaticDelphiFail
+  '  // d:=a; forbidden in delphi',
+  '  DoIt(d);',
+  '  DoIt(s);',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestArray_CopyConcat;
 begin
   StartProgram(false);

packages/pastojs/src/fppas2js.pp

@@ -355,6 +355,7 @@ Works:
 - typecast TJSFunction(func)
 
 ToDos:
+- bug: DoIt(typeinfo(i))  where DoIt is in another unit and has TTypeInfo
 - bug:
   v:=a[0]  gives Local variable "a" is assigned but never used
 - bug: