Просмотр исходного кода

* fix for Mantis #36909: apply patch by Ryan Joseph so that array constructors can be used for static arrays as well.
+ added test

git-svn-id: trunk@46891 -

svenbarth 4 лет назад
Родитель
Сommit
2ff18e48a0

+ 7 - 0
.gitattributes

@@ -14398,6 +14398,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
@@ -14405,6 +14411,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

+ 71 - 2
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;
@@ -151,6 +152,7 @@ interface
           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;
@@ -2083,6 +2085,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 +2329,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 +2459,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 +4045,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 +4323,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;

+ 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.