Browse Source

+ add support for dynamic array constants
+ added test

git-svn-id: trunk@39041 -

svenbarth 7 years ago
parent
commit
08dd4e5445
3 changed files with 155 additions and 4 deletions
  1. 1 0
      .gitattributes
  2. 53 4
      compiler/ngtcon.pas
  3. 101 0
      tests/test/tarray15.pp

+ 1 - 0
.gitattributes

@@ -12502,6 +12502,7 @@ tests/test/tarray11.pp svneol=native#text/pascal
 tests/test/tarray12.pp svneol=native#text/pascal
 tests/test/tarray12.pp svneol=native#text/pascal
 tests/test/tarray13.pp svneol=native#text/pascal
 tests/test/tarray13.pp svneol=native#text/pascal
 tests/test/tarray14.pp svneol=native#text/pascal
 tests/test/tarray14.pp svneol=native#text/pascal
+tests/test/tarray15.pp svneol=native#text/pascal
 tests/test/tarray2.pp svneol=native#text/plain
 tests/test/tarray2.pp svneol=native#text/plain
 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

+ 53 - 4
compiler/ngtcon.pas

@@ -1168,15 +1168,64 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         ca  : pbyte;
         ca  : pbyte;
         int_const: tai_const;
         int_const: tai_const;
         char_size: integer;
         char_size: integer;
+        dyncount,
         oldoffset: asizeint;
         oldoffset: asizeint;
         dummy : byte;
         dummy : byte;
+        sectype : tasmsectiontype;
+        oldtcb,
+        datatcb : ttai_typedconstbuilder;
+        ll : tasmlabel;
+        dyncountloc : ttypedconstplaceholder;
+        llofs : tasmlabofs;
+        dynarrdef : tdef;
       begin
       begin
-        { dynamic array nil }
+        { dynamic array }
         if is_dynamic_array(def) then
         if is_dynamic_array(def) then
           begin
           begin
-            { Only allow nil initialization }
-            consume(_NIL);
-            ftcb.emit_tai(Tai_const.Create_sym(nil),def);
+            if try_to_consume(_NIL) then
+              begin
+                ftcb.emit_tai(Tai_const.Create_sym(nil),def);
+              end
+            else if try_to_consume(_LKLAMMER) then
+              begin
+                if try_to_consume(_RKLAMMER) then
+                  begin
+                    ftcb.emit_tai(tai_const.create_sym(nil),def);
+                  end
+                else
+                  begin
+                    if fsym.varspez=vs_const then
+                      sectype:=sec_rodata
+                    else
+                      sectype:=sec_data;
+                    ftcb.start_internal_data_builder(fdatalist,sectype,'',datatcb,ll);
+
+                    llofs:=datatcb.begin_dynarray_const(def,ll,dyncountloc);
+
+                    dyncount:=0;
+
+                    oldtcb:=ftcb;
+                    ftcb:=datatcb;
+                    while true do
+                      begin
+                        read_typed_const_data(def.elementdef);
+                        inc(dyncount);
+                        if try_to_consume(_RKLAMMER) then
+                          break
+                        else
+                          consume(_COMMA);
+                      end;
+                    ftcb:=oldtcb;
+
+                    dynarrdef:=datatcb.end_dynarray_const(def,dyncount,dyncountloc);
+
+                    ftcb.finish_internal_data_builder(datatcb,ll,dynarrdef,sizeof(pint));
+
+                    ftcb.emit_dynarray_offset(llofs,dyncount,def);
+                  end;
+              end
+            else
+              consume(_LKLAMMER);
           end
           end
         { packed array constant }
         { packed array constant }
         else if is_packed_array(def) and
         else if is_packed_array(def) and

+ 101 - 0
tests/test/tarray15.pp

@@ -0,0 +1,101 @@
+program tarray15;
+
+{$define target_supports_rodata}
+{$if defined(msdos)}
+{$undefine target_supports_rodata}
+{$endif}
+
+{$mode  objfpc}
+
+{ needed for "except" to work }
+uses
+  SysUtils;
+
+{$ifdef InLazIDE}
+function CheckArray(aArr, aExpected: array of LongInt): Boolean;
+{$else}
+generic function CheckArray<T>(aArr, aExpected: array of T): Boolean;
+{$endif}
+var
+  i: LongInt;
+begin
+  if Length(aArr) <> Length(aExpected) then
+    Exit(False);
+  for i := Low(aArr) to High(aArr) do
+    if aArr[i] <> aExpected[i] then
+      Exit(False);
+  Result := True;
+end;
+
+var
+  v1: array of LongInt = Nil;
+  v2: array of LongInt = ();
+  v3: array of LongInt = (1, 2, 3);
+  v4: array of String = ('Alpha', 'Beta', 'Gamma', 'Delta');
+  v5: array[0..2] of array of LongInt = (Nil, (), (1, 2, 3));
+  v6: array of array[0..2] of LongInt = ((1, 2, 3), (4, 5, 6));
+  v7: array[0..2] of array of array[0..2] of LongInt = (((1, 2, 3), (4, 5, 6)), (), ((7, 8, 9)));
+
+{$push}
+{$J-}
+const
+  rc1: array of LongInt = (1, 2, 3);
+{$J+}
+const
+  wc1: array of LongInt = (1, 2, 3);
+{$pop}
+
+begin
+  if Length(v1) <> 0 then
+    Halt(1);
+  if Length(v2) <> 0 then
+    Halt(2);
+{$ifndef InLazIDE}
+  if not specialize CheckArray<LongInt>(v3, [1, 2, 3]) then
+    Halt(3);
+  if not specialize CheckArray<String>(v4, ['Alpha', 'Beta', 'Gamma', 'Delta']) then
+    Halt(4);
+  if Length(v5[0]) <> 0 then
+    Halt(5);
+  if Length(v5[1]) <> 0 then
+    Halt(6);
+  if not specialize CheckArray<LongInt>(v5[2], [1, 2, 3]) then
+    Halt(7);
+  if Length(v6) <> 2 then
+    Halt(8);
+  if not specialize CheckArray<LongInt>(v6[0], [1, 2, 3]) then
+    Halt(9);
+  if not specialize CheckArray<LongInt>(v6[1], [4, 5, 6]) then
+    Halt(10);
+  if Length(v7[0]) <> 2 then
+    Halt(11);
+  if Length(v7[1]) <> 0 then
+    Halt(12);
+  if Length(v7[2]) <> 1 then
+    Halt(13);
+  if not specialize CheckArray<LongInt>(v7[0, 0], [1, 2, 3]) then
+    Halt(14);
+  if not specialize CheckArray<LongInt>(v7[0, 1], [4, 5, 6]) then
+    Halt(15);
+  if not specialize CheckArray<LongInt>(v7[2, 0], [7, 8, 9]) then
+    Halt(16);
+  v3[1] := 42;
+  if not specialize CheckArray<LongInt>(v3, [1, 42, 3]) then
+    Halt(17);
+  if not specialize CheckArray<LongInt>(rc1, [1, 2, 3]) then
+    Halt(18);
+{$ifdef target_supports_rodata}
+  try
+    rc1[1] := 42;
+    Halt(19);
+  except
+  end;
+{$endif}
+  if not specialize CheckArray<LongInt>(wc1, [1, 2, 3]) then
+    Halt(20);
+  wc1[1] := 42;
+  if not specialize CheckArray<LongInt>(wc1, [1, 42, 3]) then
+    Halt(21);
+{$endif}
+  Writeln('ok');
+end.