Browse Source

* synchronized with trunk

git-svn-id: branches/wasm@46894 -
nickysn 4 years ago
parent
commit
0967f0c371

+ 8 - 0
.gitattributes

@@ -14429,6 +14429,7 @@ tests/test/tarray19.pp svneol=native#text/pascal
 tests/test/tarray2.pp svneol=native#text/plain
 tests/test/tarray2.pp svneol=native#text/plain
 tests/test/tarray20.pp svneol=native#text/pascal
 tests/test/tarray20.pp svneol=native#text/pascal
 tests/test/tarray21.pp svneol=native#text/pascal
 tests/test/tarray21.pp svneol=native#text/pascal
+tests/test/tarray22.pp svneol=native#text/pascal
 tests/test/tarray3.pp svneol=native#text/plain
 tests/test/tarray3.pp svneol=native#text/plain
 tests/test/tarray4.pp svneol=native#text/plain
 tests/test/tarray4.pp svneol=native#text/plain
 tests/test/tarray5.pp svneol=native#text/plain
 tests/test/tarray5.pp svneol=native#text/plain
@@ -14437,6 +14438,12 @@ tests/test/tarray7.pp svneol=native#text/plain
 tests/test/tarray8.pp svneol=native#text/plain
 tests/test/tarray8.pp svneol=native#text/plain
 tests/test/tarray9.pp svneol=native#text/plain
 tests/test/tarray9.pp svneol=native#text/plain
 tests/test/tarrconstr1.pp svneol=native#text/pascal
 tests/test/tarrconstr1.pp svneol=native#text/pascal
+tests/test/tarrconstr10.pp svneol=native#text/pascal
+tests/test/tarrconstr11.pp svneol=native#text/pascal
+tests/test/tarrconstr12.pp svneol=native#text/pascal
+tests/test/tarrconstr13.pp svneol=native#text/pascal
+tests/test/tarrconstr14.pp svneol=native#text/pascal
+tests/test/tarrconstr15.pp svneol=native#text/pascal
 tests/test/tarrconstr2.pp svneol=native#text/pascal
 tests/test/tarrconstr2.pp svneol=native#text/pascal
 tests/test/tarrconstr3.pp svneol=native#text/pascal
 tests/test/tarrconstr3.pp svneol=native#text/pascal
 tests/test/tarrconstr4.pp svneol=native#text/pascal
 tests/test/tarrconstr4.pp svneol=native#text/pascal
@@ -14444,6 +14451,7 @@ tests/test/tarrconstr5.pp svneol=native#text/pascal
 tests/test/tarrconstr6.pp svneol=native#text/pascal
 tests/test/tarrconstr6.pp svneol=native#text/pascal
 tests/test/tarrconstr7.pp svneol=native#text/pascal
 tests/test/tarrconstr7.pp svneol=native#text/pascal
 tests/test/tarrconstr8.pp svneol=native#text/pascal
 tests/test/tarrconstr8.pp svneol=native#text/pascal
+tests/test/tarrconstr9.pp svneol=native#text/pascal
 tests/test/tasm1.pp svneol=native#text/plain
 tests/test/tasm1.pp svneol=native#text/plain
 tests/test/tasm10.pp svneol=native#text/plain
 tests/test/tasm10.pp svneol=native#text/plain
 tests/test/tasm10a.pp svneol=native#text/plain
 tests/test/tasm10a.pp svneol=native#text/plain

+ 13 - 1
compiler/defcmp.pas

@@ -105,7 +105,8 @@ interface
           tc_variant_2_interface,
           tc_variant_2_interface,
           tc_array_2_dynarray,
           tc_array_2_dynarray,
           tc_elem_2_openarray,
           tc_elem_2_openarray,
-          tc_arrayconstructor_2_dynarray
+          tc_arrayconstructor_2_dynarray,
+          tc_arrayconstructor_2_array
        );
        );
 
 
     function compare_defs_ext(def_from,def_to : tdef;
     function compare_defs_ext(def_from,def_to : tdef;
@@ -1168,6 +1169,17 @@ implementation
                               eq:=te_convert_l1;
                               eq:=te_convert_l1;
                               doconv:=tc_string_2_chararray;
                               doconv:=tc_string_2_chararray;
                             end
                             end
+                        else
+                          { to normal array }
+                          if is_normal_array(def_to) and is_array_constructor(def_from) then
+                            begin
+                              { element count must match exactly }
+                              if tarraydef(def_to).elecount=tarraydef(def_from).elecount then
+                                begin
+                                  eq:=te_convert_l2;
+                                  doconv:=tc_arrayconstructor_2_array;
+                                end;
+                            end
                         else
                         else
                          { other arrays }
                          { other arrays }
                           begin
                           begin

+ 79 - 9
compiler/ncnv.pas

@@ -119,6 +119,7 @@ interface
           function typecheck_array_2_dynarray : tnode; virtual;
           function typecheck_array_2_dynarray : tnode; virtual;
           function typecheck_elem_2_openarray : tnode; virtual;
           function typecheck_elem_2_openarray : tnode; virtual;
           function typecheck_arrayconstructor_to_dynarray : tnode; virtual;
           function typecheck_arrayconstructor_to_dynarray : tnode; virtual;
+          function typecheck_arrayconstructor_to_array : tnode; virtual;
        private
        private
           function _typecheck_int_to_int : tnode;
           function _typecheck_int_to_int : tnode;
           function _typecheck_cord_to_pointer : tnode;
           function _typecheck_cord_to_pointer : tnode;
@@ -150,7 +151,8 @@ interface
           function _typecheck_interface_to_variant : tnode;
           function _typecheck_interface_to_variant : tnode;
           function _typecheck_array_2_dynarray : tnode;
           function _typecheck_array_2_dynarray : tnode;
           function _typecheck_elem_2_openarray : tnode;
           function _typecheck_elem_2_openarray : tnode;
-          function _typecheck_arrayconstructor_to_dynarray: tnode;
+          function _typecheck_arrayconstructor_to_dynarray : tnode;
+          function _typecheck_arrayconstructor_to_array : tnode;
        protected
        protected
           function first_int_to_int : tnode;virtual;
           function first_int_to_int : tnode;virtual;
           function first_cstring_to_pchar : tnode;virtual;
           function first_cstring_to_pchar : tnode;virtual;
@@ -1999,12 +2001,13 @@ implementation
 
 
     function ttypeconvnode.typecheck_arrayconstructor_to_dynarray : tnode;
     function ttypeconvnode.typecheck_arrayconstructor_to_dynarray : tnode;
       var
       var
-        newstatement,assstatement:tstatementnode;
-        arrnode:ttempcreatenode;
-        temp2:ttempcreatenode;
-        assnode:tnode;
-        paracount:integer;
-        elemnode:tarrayconstructornode;
+        newstatement,
+        assstatement : tstatementnode;
+        arrnode : ttempcreatenode;
+        temp2 : ttempcreatenode;
+        assnode : tnode;
+        paracount : integer;
+        elemnode : tarrayconstructornode;
       begin
       begin
         { assignment of []? }
         { assignment of []? }
         if (
         if (
@@ -2083,6 +2086,64 @@ implementation
       end;
       end;
 
 
 
 
+    function ttypeconvnode.typecheck_arrayconstructor_to_array : tnode;
+      var
+        newstatement,
+        assstatement : tstatementnode;
+        arrnode : ttempcreatenode;
+        temp2 : ttempcreatenode;
+        assnode : tnode;
+        paracount : integer;
+        elemnode : tarrayconstructornode;
+      begin
+        tarrayconstructornode(left).force_type(tarraydef(resultdef).elementdef);
+
+        result:=internalstatements(newstatement);
+        { create temp for result }
+        arrnode:=ctempcreatenode.create(totypedef,totypedef.size,tt_persistent,true);
+        addstatement(newstatement,arrnode);
+
+        paracount:=0;
+
+        { create an assignment call for each element }
+        assnode:=internalstatements(assstatement);
+        if left.nodetype=arrayconstructorrangen then
+          internalerror(2020041402);
+        elemnode:=tarrayconstructornode(left);
+        while assigned(elemnode) do
+          begin
+            { arr[i] := param_i }
+            if not assigned(elemnode.left) then
+              internalerror(2020041403);
+            addstatement(assstatement,
+              cassignmentnode.create(
+                cvecnode.create(
+                  ctemprefnode.create(arrnode),
+                  cordconstnode.create(paracount,tarraydef(totypedef).rangedef,false)),
+                elemnode.left));
+            elemnode.left:=nil;
+            inc(paracount);
+            elemnode:=tarrayconstructornode(elemnode.right);
+            if assigned(elemnode) and (elemnode.nodetype<>arrayconstructorn) then
+              internalerror(2020041404);
+          end;
+
+        { get temp for array of lengths }
+        temp2:=ctempcreatenode.create_value(sinttype,sinttype.size,tt_persistent,false,cordconstnode.create(paracount,s32inttype,true));
+        addstatement(newstatement,temp2);
+
+        { add assignment statememnts }
+        addstatement(newstatement,ctempdeletenode.create(temp2));
+        addstatement(newstatement,assnode);
+        { the last statement should return the value as
+          location and type, this is done be referencing the
+          temp and converting it first from a persistent temp to
+          normal temp }
+        addstatement(newstatement,ctempdeletenode.create_normal_temp(arrnode));
+        addstatement(newstatement,ctemprefnode.create(arrnode));
+      end;
+
+
     function ttypeconvnode._typecheck_int_to_int : tnode;
     function ttypeconvnode._typecheck_int_to_int : tnode;
       begin
       begin
         result := typecheck_int_to_int;
         result := typecheck_int_to_int;
@@ -2269,6 +2330,12 @@ implementation
       end;
       end;
 
 
 
 
+    function ttypeconvnode._typecheck_arrayconstructor_to_array : tnode;
+      begin
+        result:=typecheck_arrayconstructor_to_array;
+      end;
+
+
     function ttypeconvnode.target_specific_general_typeconv: boolean;
     function ttypeconvnode.target_specific_general_typeconv: boolean;
       begin
       begin
         result:=false;
         result:=false;
@@ -2393,7 +2460,8 @@ implementation
           { interface_2_variant} @ttypeconvnode._typecheck_variant_to_interface,
           { interface_2_variant} @ttypeconvnode._typecheck_variant_to_interface,
           { array_2_dynarray} @ttypeconvnode._typecheck_array_2_dynarray,
           { array_2_dynarray} @ttypeconvnode._typecheck_array_2_dynarray,
           { elem_2_openarray } @ttypeconvnode._typecheck_elem_2_openarray,
           { elem_2_openarray } @ttypeconvnode._typecheck_elem_2_openarray,
-          { arrayconstructor_2_dynarray } @ttypeconvnode._typecheck_arrayconstructor_to_dynarray
+          { arrayconstructor_2_dynarray } @ttypeconvnode._typecheck_arrayconstructor_to_dynarray,
+          { arrayconstructor_2_array } @ttypeconvnode._typecheck_arrayconstructor_to_array
          );
          );
       type
       type
          tprocedureofobject = function : tnode of object;
          tprocedureofobject = function : tnode of object;
@@ -3978,6 +4046,7 @@ implementation
            nil,
            nil,
            nil,
            nil,
            @ttypeconvnode._first_nothing,
            @ttypeconvnode._first_nothing,
+           @ttypeconvnode._first_nothing,
            @ttypeconvnode._first_nothing
            @ttypeconvnode._first_nothing
          );
          );
       type
       type
@@ -4255,7 +4324,8 @@ implementation
            @ttypeconvnode._second_nothing,  { interface_2_variant }
            @ttypeconvnode._second_nothing,  { interface_2_variant }
            @ttypeconvnode._second_nothing,  { array_2_dynarray }
            @ttypeconvnode._second_nothing,  { array_2_dynarray }
            @ttypeconvnode._second_elem_to_openarray,  { elem_2_openarray }
            @ttypeconvnode._second_elem_to_openarray,  { elem_2_openarray }
-           @ttypeconvnode._second_nothing   { arrayconstructor_2_dynarray }
+           @ttypeconvnode._second_nothing,  { arrayconstructor_2_dynarray }
+           @ttypeconvnode._second_nothing   { arrayconstructor_2_array }
          );
          );
       type
       type
          tprocedureofobject = procedure of object;
          tprocedureofobject = procedure of object;

+ 52 - 11
compiler/ninl.pas

@@ -1914,7 +1914,16 @@ implementation
           begin
           begin
             minargs:=1;
             minargs:=1;
             resultdef:=paradef;
             resultdef:=paradef;
-            func:='fpc_dynarray_copy';
+            func:='fpc_array_to_dynarray_copy';
+          end
+        else
+         if is_open_array(paradef) then
+          begin
+            minargs:=1;
+            resultdef:=carraydef.create(0,-1,tarraydef(paradef).rangedef);
+            tarraydef(resultdef).arrayoptions:=tarraydef(resultdef).arrayoptions+[ado_IsDynamicArray];
+            tarraydef(resultdef).elementdef:=tarraydef(paradef).elementdef;
+            func:='fpc_array_to_dynarray_copy';
           end
           end
         else if counter in [2..3] then
         else if counter in [2..3] then
           begin
           begin
@@ -4697,7 +4706,12 @@ implementation
     function tinlinenode.first_copy: tnode;
     function tinlinenode.first_copy: tnode;
       var
       var
         lowppn,
         lowppn,
-        highppn,
+        countppn,
+        elesizeppn,
+        eletypeppn,
+        maxcountppn,
+        arrayppn,
+        rttippn,
         npara,
         npara,
         paras   : tnode;
         paras   : tnode;
         ppn     : tcallparanode;
         ppn     : tcallparanode;
@@ -4737,30 +4751,57 @@ implementation
         else if is_dynamic_array(resultdef) then
         else if is_dynamic_array(resultdef) then
           begin
           begin
             { create statements with call }
             { create statements with call }
+            elesizeppn:=cordconstnode.create(tarraydef(paradef).elesize,sinttype,false);
+            if is_managed_type(tarraydef(paradef).elementdef) then
+              eletypeppn:=caddrnode.create_internal(
+                crttinode.create(tstoreddef(tarraydef(paradef).elementdef),fullrtti,rdt_normal))
+            else
+              eletypeppn:=cordconstnode.create(0,voidpointertype,false);
+            maxcountppn:=geninlinenode(in_length_x,false,ppn.left.getcopy);
             case counter of
             case counter of
               1:
               1:
                 begin
                 begin
                   { copy the whole array using [0..high(sizeint)] range }
                   { copy the whole array using [0..high(sizeint)] range }
-                  highppn:=cordconstnode.create(torddef(sinttype).high,sinttype,false);
+                  countppn:=cordconstnode.create(torddef(sinttype).high,sinttype,false);
                   lowppn:=cordconstnode.create(0,sinttype,false);
                   lowppn:=cordconstnode.create(0,sinttype,false);
                 end;
                 end;
+              2:
+                begin
+                  { copy the array using [low..high(sizeint)] range }
+                  countppn:=cordconstnode.create(torddef(sinttype).high,sinttype,false);
+                  lowppn:=tcallparanode(paras).left.getcopy;
+                end;
               3:
               3:
                 begin
                 begin
-                  highppn:=tcallparanode(paras).left.getcopy;
+                  countppn:=tcallparanode(paras).left.getcopy;
                   lowppn:=tcallparanode(tcallparanode(paras).right).left.getcopy;
                   lowppn:=tcallparanode(tcallparanode(paras).right).left.getcopy;
                 end;
                 end;
               else
               else
                 internalerror(2012100701);
                 internalerror(2012100701);
             end;
             end;
 
 
-            { create call to fpc_dynarray_copy }
-            npara:=ccallparanode.create(highppn,
+            if is_open_array(paradef) then
+              begin
+                arrayppn:=caddrnode.create_internal(ppn.left);
+              end
+            else if is_dynamic_array(paradef) then
+              begin
+                arrayppn:=ctypeconvnode.create_internal(ppn.left,voidpointertype);
+              end
+            else
+              internalerror(2012100702);
+
+            rttippn:=caddrnode.create_internal(crttinode.create(tstoreddef(resultdef),initrtti,rdt_normal));
+
+            { create call to fpc_array_to_dynarray_copy }
+            npara:=ccallparanode.create(eletypeppn,
+                   ccallparanode.create(elesizeppn,
+                   ccallparanode.create(maxcountppn,
+                   ccallparanode.create(countppn,
                    ccallparanode.create(lowppn,
                    ccallparanode.create(lowppn,
-                   ccallparanode.create(caddrnode.create_internal
-                      (crttinode.create(tstoreddef(paradef),initrtti,rdt_normal)),
-                   ccallparanode.create
-                      (ctypeconvnode.create_internal(ppn.left,voidpointertype),nil))));
-            result:=ccallnode.createinternres('fpc_dynarray_copy',npara,paradef);
+                   ccallparanode.create(rttippn,
+                   ccallparanode.create(arrayppn,nil)))))));
+            result:=ccallnode.createinternres('fpc_array_to_dynarray_copy',npara,resultdef);
 
 
             ppn.left:=nil;
             ppn.left:=nil;
             paras.free;
             paras.free;

+ 4 - 1
packages/fcl-passrc/src/paswrite.pp

@@ -1256,7 +1256,10 @@ begin
     if DoBeginEnd then
     if DoBeginEnd then
       AddLn('begin');
       AddLn('begin');
     IncIndent;
     IncIndent;
-    WriteImplElement(AIfElse.IfBranch, False);
+    if AIfElse.IfBranch is TPasImplBeginBlock then
+       WriteImplBlock(TPasImplBeginBlock(AIfElse.IfBranch))
+     else
+       WriteImplElement(AIfElse.IfBranch, False);
     DecIndent;
     DecIndent;
     if DoBeginEnd then
     if DoBeginEnd then
       begin
       begin

+ 1 - 1
packages/fv/src/sysmsg.pas

@@ -104,7 +104,7 @@ begin
    begin
    begin
      PendingSystemTail^:=SystemEvent;
      PendingSystemTail^:=SystemEvent;
      inc(PendingSystemTail);
      inc(PendingSystemTail);
-     if longint(PendingSystemTail)=longint(@PendingSystemEvent)+sizeof(PendingSystemEvent) then
+     if PtrUInt(PendingSystemTail)=PtrUInt(@PendingSystemEvent)+sizeof(PendingSystemEvent) then
       PendingSystemTail:=@PendingSystemEvent;
       PendingSystemTail:=@PendingSystemEvent;
        inc(PendingSystemEvents);
        inc(PendingSystemEvents);
    end;
    end;

+ 1 - 1
packages/fv/src/views.pas

@@ -2117,7 +2117,7 @@ BEGIN
      Tp := Last;                                      { Set temporary ptr }
      Tp := Last;                                      { Set temporary ptr }
      Repeat
      Repeat
        Tp := Tp^.Next;                                { Get next view }
        Tp := Tp^.Next;                                { Get next view }
-         IF Byte(Longint(CallPointerMethodLocal(TCallbackFunBoolParam(P),
+         IF Byte(PtrUInt(CallPointerMethodLocal(TCallbackFunBoolParam(P),
          { On most systems, locals are accessed relative to base pointer,
          { On most systems, locals are accessed relative to base pointer,
            but for MIPS cpu, they are accessed relative to stack pointer.
            but for MIPS cpu, they are accessed relative to stack pointer.
            This needs adaptation for so low level routines,
            This needs adaptation for so low level routines,

+ 1 - 1
packages/fv/src/w32smsg.inc

@@ -145,7 +145,7 @@ begin
   EnterCriticalSection(ChangeSystemEvents);
   EnterCriticalSection(ChangeSystemEvents);
   SystemEvent:=PendingSystemHead^;
   SystemEvent:=PendingSystemHead^;
   inc(PendingSystemHead);
   inc(PendingSystemHead);
-  if ptrint(PendingSystemHead)=ptrint(@PendingSystemEvent)+sizeof(PendingSystemEvent) then
+  if PtrUInt(PendingSystemHead)=PtrUInt(@PendingSystemEvent)+sizeof(PendingSystemEvent) then
    PendingSystemHead:=@PendingSystemEvent;
    PendingSystemHead:=@PendingSystemEvent;
   dec(PendingSystemEvents);
   dec(PendingSystemEvents);
   LastSystemEvent:=SystemEvent;
   LastSystemEvent:=SystemEvent;

+ 7 - 0
rtl/inc/compproc.inc

@@ -67,8 +67,15 @@ Procedure fpc_shortstr_insert_char(source:Char;var s:shortstring;index:SizeInt);
 {$endif VER3_0}
 {$endif VER3_0}
 
 
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
+{$ifdef VER3_2}
 function fpc_dynarray_copy(psrc : pointer;ti : pointer;
 function fpc_dynarray_copy(psrc : pointer;ti : pointer;
     lowidx,count:tdynarrayindex) : fpc_stub_dynarray;compilerproc;
     lowidx,count:tdynarrayindex) : fpc_stub_dynarray;compilerproc;
+{$endif VER3_2}
+function fpc_array_to_dynarray_copy(psrc : pointer;ti : pointer;
+    lowidx,count,maxcount:tdynarrayindex;
+    elesize : sizeint;
+    eletype : pointer
+    ) : fpc_stub_dynarray;compilerproc;
 function  fpc_dynarray_length(p : pointer) : tdynarrayindex; compilerproc;
 function  fpc_dynarray_length(p : pointer) : tdynarrayindex; compilerproc;
 function  fpc_dynarray_high(p : pointer) : tdynarrayindex; compilerproc;
 function  fpc_dynarray_high(p : pointer) : tdynarrayindex; compilerproc;
 procedure fpc_dynarray_clear(var p : pointer;ti : pointer); compilerproc;
 procedure fpc_dynarray_clear(var p : pointer;ti : pointer); compilerproc;

+ 40 - 26
rtl/inc/dynarr.inc

@@ -315,21 +315,54 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
   end;
   end;
 
 
 
 
-{ provide local access to dynarr_copy }
-function int_dynarray_copy(psrc : pointer;ti : pointer;
-    lowidx,count:tdynarrayindex) : fpc_stub_dynarray;[external name 'FPC_DYNARR_COPY'];
+{ provide local access to array_to_dynarray_copy }
+function int_array_to_dynarray_copy(psrc : pointer;ti : pointer;
+    lowidx,count,maxcount:tdynarrayindex;
+    elesize : sizeint;
+    eletype : pointer
+    ) : fpc_stub_dynarray;[external name 'FPC_ARR_TO_DYNARR_COPY'];
+
 
 
+{$ifdef VER3_2}
 function fpc_dynarray_copy(psrc : pointer;ti : pointer;
 function fpc_dynarray_copy(psrc : pointer;ti : pointer;
     lowidx,count:tdynarrayindex) : fpc_stub_dynarray;[Public,Alias:'FPC_DYNARR_COPY'];compilerproc;
     lowidx,count:tdynarrayindex) : fpc_stub_dynarray;[Public,Alias:'FPC_DYNARR_COPY'];compilerproc;
   var
   var
     realpsrc : pdynarray;
     realpsrc : pdynarray;
-    i,size : sizeint;
+    eletype,tti : pointer;
+    elesize : sizeint;
+  begin
+     fpc_dynarray_clear(pointer(result),ti);
+     if psrc=nil then
+       exit;
+
+     realpsrc:=pdynarray(psrc-sizeof(tdynarray));
+
+     tti:=aligntoqword(ti+2+PByte(ti)[1]);
+
+     elesize:=pdynarraytypedata(tti)^.elSize;
+     { only set if type needs finalization }
+     if assigned(pdynarraytypedata(tti)^.elType) then
+       eletype:=pdynarraytypedata(tti)^.elType^
+     else
+       eletype:=nil;
+
+     fpc_array_to_dynarray_copy(psrc,ti,lowidx,count,realpsrc^.high+1,elesize,eletype);
+  end;
+{$endif VER3_2}
+
+{ copy a custom array (open/dynamic/static) to dynamic array }
+function fpc_array_to_dynarray_copy(psrc : pointer;ti : pointer;
+    lowidx,count,maxcount:tdynarrayindex;
     elesize : sizeint;
     elesize : sizeint;
-    eletype : pointer;
+    eletype : pointer
+    ) : fpc_stub_dynarray;[Public,Alias:'FPC_ARR_TO_DYNARR_COPY'];compilerproc;
+  var
+    i,size : sizeint;
   begin
   begin
      fpc_dynarray_clear(pointer(result),ti);
      fpc_dynarray_clear(pointer(result),ti);
      if psrc=nil then
      if psrc=nil then
        exit;
        exit;
+
 {$ifndef FPC_DYNARRAYCOPY_FIXED}
 {$ifndef FPC_DYNARRAYCOPY_FIXED}
      if (lowidx=-1) and (count=-1) then
      if (lowidx=-1) and (count=-1) then
        begin
        begin
@@ -337,7 +370,6 @@ function fpc_dynarray_copy(psrc : pointer;ti : pointer;
          count:=high(tdynarrayindex);
          count:=high(tdynarrayindex);
        end;
        end;
 {$endif FPC_DYNARRAYCOPY_FIXED}
 {$endif FPC_DYNARRAYCOPY_FIXED}
-     realpsrc:=pdynarray(psrc-sizeof(tdynarray));
      if (lowidx<0) then
      if (lowidx<0) then
        begin
        begin
        { Decrease count if index is negative, this is different from how copy()
        { Decrease count if index is negative, this is different from how copy()
@@ -347,29 +379,11 @@ function fpc_dynarray_copy(psrc : pointer;ti : pointer;
          count:=count+lowidx;
          count:=count+lowidx;
          lowidx:=0;
          lowidx:=0;
        end;
        end;
-     if (count>realpsrc^.high-lowidx+1) then
-       count:=realpsrc^.high-lowidx+1;
+     if (count>maxcount-lowidx) then
+       count:=maxcount-lowidx;
      if count<=0 then
      if count<=0 then
        exit;
        exit;
 
 
-     { skip kind and name }
-{$ifdef VER3_0}
-     ti:=aligntoptr(ti+2+PByte(ti)[1]);
-{$else VER3_0}
-     ti:=aligntoqword(ti+2+PByte(ti)[1]);
-{$endif VER3_0}
-
-     elesize:=pdynarraytypedata(ti)^.elSize;
-     { only set if type needs finalization }
-     {$ifdef VER3_0}
-     eletype:=pdynarraytypedata(ti)^.elType;
-     {$else}
-     if assigned(pdynarraytypedata(ti)^.elType) then
-       eletype:=pdynarraytypedata(ti)^.elType^
-     else
-       eletype:=nil;
-     {$endif}
-
      { create new array }
      { create new array }
      size:=elesize*count;
      size:=elesize*count;
      getmem(pointer(result),size+sizeof(tdynarray));
      getmem(pointer(result),size+sizeof(tdynarray));

+ 99 - 0
tests/test/tarray22.pp

@@ -0,0 +1,99 @@
+{ %OPT = -gh }
+
+program tarray22;
+
+{$mode objfpc}{$h+}
+
+type
+  TIntegerArray = array of Integer;
+  TStringArray = array of String;
+
+generic procedure CheckArray<T>(const Actual, Expected: array of T; Code: LongInt);
+var
+  i: SizeInt;
+begin
+  if Length(Actual) <> Length(Expected) then
+    Halt(Code);
+  for i := 0 to High(Actual) do
+    if Actual[i] <> Expected[i] then
+      Halt(Code);
+end;
+
+procedure TestOpen(const A: array of Integer; Exp: array of Integer; Code: LongInt);
+var
+  B: array of Integer;
+begin
+  B := Copy(A);
+  specialize CheckArray<Integer>(B, Exp, Code);
+end;
+
+procedure TestOpen2(const A: array of Integer; Exp: array of Integer; Code: LongInt);
+var
+  B: array of Integer;
+begin
+  B := Copy(A, 1, 2);
+  specialize CheckArray<Integer>(B, Exp, Code);
+end;
+
+procedure TestDyn(const A: TIntegerArray; Exp: array of Integer; Code: LongInt);
+var
+  B: array of Integer;
+begin
+  B := Copy(A);
+  specialize CheckArray<Integer>(B, Exp, Code);
+end;
+
+procedure TestDyn2(const A: TIntegerArray; Exp: array of Integer; Code: LongInt);
+var
+  B: array of Integer;
+begin
+  B := Copy(A, 1, 2);
+  specialize CheckArray<Integer>(B, Exp, Code);
+end;
+
+procedure TestOpen(const A: array of String; Exp: array of String; Code: LongInt);
+var
+  B: array of String;
+begin
+  B := Copy(A);
+  specialize CheckArray<String>(B, Exp, Code);
+end;
+
+procedure TestOpen2(const A: array of String; Exp: array of String; Code: LongInt);
+var
+  B: array of String;
+begin
+  B := Copy(A, 1, 2);
+  specialize CheckArray<String>(B, Exp, Code);
+end;
+
+procedure TestDyn(const A: TStringArray; Exp: array of String; Code: LongInt);
+var
+  B: array of String;
+begin
+  B := Copy(A);
+  specialize CheckArray<String>(B, Exp, Code);
+end;
+
+procedure TestDyn2(const A: TStringArray; Exp: array of String; Code: LongInt);
+var
+  B: array of String;
+begin
+  B := Copy(A, 1, 2);
+  specialize CheckArray<String>(B, Exp, Code);
+end;
+
+begin
+  HaltOnNotReleased := True;
+
+  TestOpen([0, 1, 2, 3, 4, 5], [0, 1, 2, 3, 4, 5], 1);
+  TestOpen2([0, 1, 2, 3, 4, 5], [1, 2], 2);
+  TestDyn([0, 1, 2, 3, 4, 5], [0, 1, 2, 3, 4, 5], 3);
+  TestDyn2([0, 1, 2, 3, 4, 5], [1, 2], 4);
+
+  TestOpen(['Alpha', 'Beta', 'Gamma', 'Delta'], ['Alpha', 'Beta', 'Gamma', 'Delta'], 5);
+  TestOpen2(['Alpha', 'Beta', 'Gamma', 'Delta'], ['Beta', 'Gamma'], 6);
+  TestDyn(['Alpha', 'Beta', 'Gamma', 'Delta'], ['Alpha', 'Beta', 'Gamma', 'Delta'], 7);
+  TestDyn2(['Alpha', 'Beta', 'Gamma', 'Delta'], ['Beta', 'Gamma'], 8);
+end.
+

+ 10 - 0
tests/test/tarrconstr10.pp

@@ -0,0 +1,10 @@
+{%FAIL}
+{$mode objfpc}
+
+program tarrconstr10;
+
+var
+  a: array[0..2] of integer;
+begin
+  a := [1,2];
+end.

+ 10 - 0
tests/test/tarrconstr11.pp

@@ -0,0 +1,10 @@
+{%FAIL}
+{$mode objfpc}
+
+program tarrconstr11;
+
+var
+  a: array[0..2] of integer;
+begin
+  a := [1,2,3,4];
+end.

+ 29 - 0
tests/test/tarrconstr12.pp

@@ -0,0 +1,29 @@
+{$mode objfpc}
+
+program tarrconstr12;
+
+procedure CheckArray(Actual, Expected: array of Integer; Code: LongInt);
+var
+  i: SizeInt;
+begin
+  if Length(Actual) <> Length(Expected) then
+    Halt(Code);
+  for i := 0 to High(Actual) do
+    if Actual[i] <> Expected[i] then
+      Halt(Code);
+end;
+
+var
+  a: array[0..2,0..2] of integer;
+  i, j: integer;
+begin
+  a := [[1,2,3],[10,20,30],[100,200,300]];
+
+  for i := 0 to 2 do
+    for j := 0 to 2 do
+      writeln(i,',',j,':',a[i,j]);
+
+  CheckArray(a[0], [1, 2, 3], 1);
+  CheckArray(a[1], [10,20,30], 2);
+  CheckArray(a[2], [100,200,300], 3);
+end.

+ 10 - 0
tests/test/tarrconstr13.pp

@@ -0,0 +1,10 @@
+{%FAIL}
+{$mode objfpc}
+
+program tarrconstr13;
+
+var
+  a: array[0..0] of integer;
+begin
+  a := ['a'];
+end.

+ 10 - 0
tests/test/tarrconstr14.pp

@@ -0,0 +1,10 @@
+{%FAIL}
+{$mode objfpc}
+
+program tarrconstr14;
+
+var
+  a: array[0..2] of integer;
+begin
+  a := [];
+end.

+ 30 - 0
tests/test/tarrconstr15.pp

@@ -0,0 +1,30 @@
+{ %OPT = -gh }
+
+program tarrconstr15;
+
+{$mode objfpc}{$H+}
+
+procedure CheckArray(Actual, Expected: array of String; Code: LongInt);
+var
+  i: SizeInt;
+begin
+  if Length(Actual) <> Length(Expected) then
+    Halt(Code);
+  for i := 0 to High(Actual) do
+    if Actual[i] <> Expected[i] then
+      Halt(Code);
+end;
+
+var
+  arr: array[0..3] of String;
+  i: SizeInt;
+begin
+  HaltOnNotReleased := True;
+
+  arr := ['Alpha', 'Beta', 'Gamma', 'Delta'];
+  CheckArray(arr, ['Alpha', 'Beta', 'Gamma', 'Delta'], 1);
+
+  { ensure that everything is freed correctly }
+  for i := Low(arr) to High(arr) do
+    UniqueString(arr[i]);
+end.

+ 9 - 0
tests/test/tarrconstr9.pp

@@ -0,0 +1,9 @@
+{$mode objfpc}
+
+program tarrconstr9;
+
+var
+  a: array[0..2] of integer;
+begin
+  a := [1,2,3];
+end.