浏览代码

* synchronized with trunk

git-svn-id: branches/wasm@48515 -
nickysn 4 年之前
父节点
当前提交
ae75c87d65
共有 4 个文件被更改,包括 71 次插入5 次删除
  1. 1 0
      .gitattributes
  2. 16 0
      compiler/aasmcnst.pas
  3. 27 5
      compiler/ngtcon.pas
  4. 27 0
      tests/webtbs/tw34027.pp

+ 1 - 0
.gitattributes

@@ -18464,6 +18464,7 @@ tests/webtbs/tw33898.pp -text svneol=native#text/pascal
 tests/webtbs/tw33963.pp svneol=native#text/pascal
 tests/webtbs/tw3402.pp svneol=native#text/plain
 tests/webtbs/tw34021.pp -text svneol=native#text/pascal
+tests/webtbs/tw34027.pp svneol=native#text/pascal
 tests/webtbs/tw34037.pp svneol=native#text/pascal
 tests/webtbs/tw34055.pp svneol=native#text/plain
 tests/webtbs/tw3411.pp svneol=native#text/plain

+ 16 - 0
compiler/aasmcnst.pas

@@ -427,6 +427,10 @@ type
      function queue_subscriptn_multiple_by_name(def: tabstractrecorddef; const fields: array of TIDString): tdef;
      { queue a type conversion operation }
      procedure queue_typeconvn(fromdef, todef: tdef); virtual;
+     { queue a add operation }
+     procedure queue_addn(def: tdef; const index: tconstexprint); virtual;
+     { queue a sub operation }
+     procedure queue_subn(def: tdef; const index: tconstexprint); virtual;
      { finalise the queue (so a new one can be created) and flush the
         previously queued operations, applying them in reverse order on a...}
      { ... procdef }
@@ -2080,6 +2084,18 @@ implementation
      end;
 
 
+   procedure ttai_typedconstbuilder.queue_addn(def: tdef; const index: tconstexprint);
+     begin
+       inc(fqueue_offset,def.size*int64(index));
+     end;
+
+
+   procedure ttai_typedconstbuilder.queue_subn(def: tdef; const index: tconstexprint);
+     begin
+       dec(fqueue_offset,def.size*int64(index));
+     end;
+
+
    procedure ttai_typedconstbuilder.queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym);
      begin
        inc(fqueue_offset,vs.fieldoffset);

+ 27 - 5
compiler/ngtcon.pas

@@ -150,7 +150,7 @@ uses
    defutil,defcmp,
    { pass 1 }
    htypechk,procinfo,
-   nmem,ncnv,ninl,ncon,nld,
+   nmem,ncnv,ninl,ncon,nld,nadd,
    { parser specific stuff }
    pbase,pexpr,
    { codegen }
@@ -826,7 +826,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         { maybe pchar ? }
         else
           if is_char(def.pointeddef) and
-             (node.nodetype<>addrn) then
+            ((node.nodetype=stringconstn) or is_constcharnode(node)) then
             begin
               { create a tcb for the string data (it's placed in a separate
                 asmlist) }
@@ -875,7 +875,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         { maybe pwidechar ? }
         else
           if is_widechar(def.pointeddef) and
-             (node.nodetype<>addrn) then
+            (node.nodetype in [stringconstn,ordconstn]) then
             begin
               if (node.nodetype in [stringconstn,ordconstn]) then
                 begin
@@ -912,13 +912,13 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                 Message(parser_e_illegal_expression);
           end
         else
-          if (node.nodetype=addrn) or
+          if (node.nodetype in [addrn,addn,subn]) or
              is_proc2procvar_load(node,pd) then
             begin
               { insert typeconv }
               inserttypeconv(node,def);
               hp:=node;
-              while assigned(hp) and (hp.nodetype in [addrn,typeconvn,subscriptn,vecn]) do
+              while assigned(hp) and (hp.nodetype in [addrn,typeconvn,subscriptn,vecn,addn,subn]) do
                 hp:=tunarynode(hp).left;
               if (hp.nodetype=loadn) then
                 begin
@@ -927,6 +927,28 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                   while assigned(hp) and (hp.nodetype<>loadn) do
                     begin
                        case hp.nodetype of
+                         addn :
+                           begin
+                             if (is_constintnode(taddnode(hp).right) or
+                               is_constenumnode(taddnode(hp).right) or
+                               is_constcharnode(taddnode(hp).right) or
+                               is_constboolnode(taddnode(hp).right)) and
+                               is_pointer(taddnode(hp).left.resultdef) then
+                               ftcb.queue_addn(tpointerdef(taddnode(hp).left.resultdef).pointeddef,get_ordinal_value(taddnode(hp).right))
+                             else
+                               Message(parser_e_illegal_expression);
+                           end;
+                         subn :
+                           begin
+                             if (is_constintnode(taddnode(hp).right) or
+                               is_constenumnode(taddnode(hp).right) or
+                               is_constcharnode(taddnode(hp).right) or
+                               is_constboolnode(taddnode(hp).right)) and
+                               is_pointer(taddnode(hp).left.resultdef) then
+                               ftcb.queue_subn(tpointerdef(taddnode(hp).left.resultdef).pointeddef,get_ordinal_value(taddnode(hp).right))
+                             else
+                               Message(parser_e_illegal_expression);
+                           end;
                          vecn :
                            begin
                              if (is_constintnode(tvecnode(hp).right) or

+ 27 - 0
tests/webtbs/tw34027.pp

@@ -0,0 +1,27 @@
+uses
+  strings;
+
+type tz = record
+       name : pchar;
+     end;
+const aa :array[0..2] of char = 'aa'#0;
+
+const testArrZ : array [0..4] of tz = (
+     (name: @aa), { Ok }
+     (name: pchar(@aa)), { Ok }
+     (name: pchar(@aa)+1),
+     (name: pchar(@aa)+1+1),
+     (name: pchar(@aa)+1+1-1)
+     );
+
+var b : pchar;
+
+begin
+  b:=pchar(@aa)+1; {Ok}
+  if strlen(testArrZ[2].name)<>1 then
+    halt(1);
+  if strlen(testArrZ[3].name)<>0 then
+    halt(2);
+  if strlen(testArrZ[4].name)<>1 then
+    halt(2);
+end.