Browse Source

* make sure valid_for_assign() returns false for inlined function bodies
(mantis #22613)

git-svn-id: trunk@22099 -

Jonas Maebe 13 years ago
parent
commit
f3ad4af343
4 changed files with 102 additions and 62 deletions
  1. 1 0
      .gitattributes
  2. 67 62
      compiler/htypechk.pas
  3. 4 0
      compiler/ncal.pas
  4. 30 0
      tests/webtbs/tw22613.pp

+ 1 - 0
.gitattributes

@@ -12781,6 +12781,7 @@ tests/webtbs/tw22561.pp svneol=native#text/plain
 tests/webtbs/tw2259.pp svneol=native#text/plain
 tests/webtbs/tw2259.pp svneol=native#text/plain
 tests/webtbs/tw22593.pp svneol=native#text/plain
 tests/webtbs/tw22593.pp svneol=native#text/plain
 tests/webtbs/tw2260.pp svneol=native#text/plain
 tests/webtbs/tw2260.pp svneol=native#text/plain
+tests/webtbs/tw22613.pp svneol=native#text/plain
 tests/webtbs/tw2266.pp svneol=native#text/plain
 tests/webtbs/tw2266.pp svneol=native#text/plain
 tests/webtbs/tw2267.pp svneol=native#text/plain
 tests/webtbs/tw2267.pp svneol=native#text/plain
 tests/webtbs/tw2268.pp svneol=native#text/plain
 tests/webtbs/tw2268.pp svneol=native#text/plain

+ 67 - 62
compiler/htypechk.pas

@@ -1524,25 +1524,6 @@ implementation
                    gotdynarray:=true;
                    gotdynarray:=true;
                  hp:=tunarynode(hp).left;
                  hp:=tunarynode(hp).left;
                end;
                end;
-             blockn :
-               begin
-                 hp2:=tblocknode(hp).statements;
-                 if assigned(hp2) then
-                   begin
-                     if hp2.nodetype<>statementn then
-                       internalerror(2006110801);
-                     while assigned(tstatementnode(hp2).next) do
-                       hp2:=tstatementnode(hp2).next;
-                     hp:=tstatementnode(hp2).statement;
-                   end
-                 else
-                   begin
-                     if report_errors then
-                      CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
-                     mayberesettypeconvs;
-                     exit;
-                   end;
-               end;
              asn :
              asn :
                begin
                begin
                  { asn can't be assigned directly, it returns the value in a register instead
                  { asn can't be assigned directly, it returns the value in a register instead
@@ -1680,53 +1661,77 @@ implementation
                  mayberesettypeconvs;
                  mayberesettypeconvs;
                  exit;
                  exit;
                end;
                end;
+             blockn,
              calln :
              calln :
                begin
                begin
-                 { check return type }
-                 case hp.resultdef.typ of
-                   arraydef :
-                     begin
-                       { dynamic arrays are allowed when there is also a
-                         vec node }
-                       if is_dynamic_array(hp.resultdef) and
-                          gotvec then
-                        begin
-                          gotderef:=true;
-                          gotpointer:=true;
-                        end;
+                 if (hp.nodetype=calln) or
+                    (nf_no_lvalue in hp.flags) then
+                   begin
+                     { check return type }
+                     case hp.resultdef.typ of
+                       arraydef :
+                         begin
+                           { dynamic arrays are allowed when there is also a
+                             vec node }
+                           if is_dynamic_array(hp.resultdef) and
+                              gotvec then
+                            begin
+                              gotderef:=true;
+                              gotpointer:=true;
+                            end;
+                         end;
+                       pointerdef :
+                         gotpointer:=true;
+                       objectdef :
+                         gotclass:=is_implicit_pointer_object_type(hp.resultdef);
+                       recorddef, { handle record like class it needs a subscription }
+                       classrefdef :
+                         gotclass:=true;
+                       stringdef :
+                         gotstring:=true;
                      end;
                      end;
-                   pointerdef :
-                     gotpointer:=true;
-                   objectdef :
-                     gotclass:=is_implicit_pointer_object_type(hp.resultdef);
-                   recorddef, { handle record like class it needs a subscription }
-                   classrefdef :
-                     gotclass:=true;
-                   stringdef :
-                     gotstring:=true;
-                 end;
-                 { 1. if it returns a pointer and we've found a deref,
-                   2. if it returns a class or record and a subscription or with is found
-                   3. string is returned }
-                 if (gotstring and gotvec) or
-                    (gotpointer and gotderef) or
-                    (gotclass and gotsubscript) then
-                  result:=true
-                 else
-                 { Temp strings are stored in memory, for compatibility with
-                   delphi only }
-                   if (m_delphi in current_settings.modeswitches) and
-                      (valid_addr in opts) and
-                      (hp.resultdef.typ=stringdef) then
-                     result:=true
-                 else
-                   if ([valid_const,valid_addr] * opts = [valid_const]) then
-                     result:=true
+                     { 1. if it returns a pointer and we've found a deref,
+                       2. if it returns a class or record and a subscription or with is found
+                       3. string is returned }
+                     if (gotstring and gotvec) or
+                        (gotpointer and gotderef) or
+                        (gotclass and gotsubscript) then
+                      result:=true
+                     else
+                     { Temp strings are stored in memory, for compatibility with
+                       delphi only }
+                       if (m_delphi in current_settings.modeswitches) and
+                          (valid_addr in opts) and
+                          (hp.resultdef.typ=stringdef) then
+                         result:=true
+                     else
+                       if ([valid_const,valid_addr] * opts = [valid_const]) then
+                         result:=true
+                     else
+                      if report_errors then
+                       CGMessagePos(hp.fileinfo,errmsg);
+                     mayberesettypeconvs;
+                     exit;
+                   end
                  else
                  else
-                  if report_errors then
-                   CGMessagePos(hp.fileinfo,errmsg);
-                 mayberesettypeconvs;
-                 exit;
+                   begin
+                     hp2:=tblocknode(hp).statements;
+                     if assigned(hp2) then
+                       begin
+                         if hp2.nodetype<>statementn then
+                           internalerror(2006110801);
+                         while assigned(tstatementnode(hp2).next) do
+                           hp2:=tstatementnode(hp2).next;
+                         hp:=tstatementnode(hp2).statement;
+                       end
+                     else
+                       begin
+                         if report_errors then
+                          CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
+                         mayberesettypeconvs;
+                         exit;
+                       end;
+                   end;
                end;
                end;
              inlinen :
              inlinen :
                begin
                begin

+ 4 - 0
compiler/ncal.pas

@@ -3970,6 +3970,10 @@ implementation
 
 
         { Create new code block for inlining }
         { Create new code block for inlining }
         inlineblock:=internalstatements(inlineinitstatement);
         inlineblock:=internalstatements(inlineinitstatement);
+        { make sure that valid_for_assign() returns false for this block
+          (otherwise assigning values to the block will result in assigning
+           values to the inlined function's result) }
+        include(inlineblock.flags,nf_no_lvalue);
         inlinecleanupblock:=internalstatements(inlinecleanupstatement);
         inlinecleanupblock:=internalstatements(inlinecleanupstatement);
 
 
         if assigned(callinitblock) then
         if assigned(callinitblock) then

+ 30 - 0
tests/webtbs/tw22613.pp

@@ -0,0 +1,30 @@
+{$inline on}
+
+function leftstr(const s: string; l: integer): ansistring; inline;
+var
+  i: longint;
+begin
+  i:=1;
+  while i<length(s) do
+    begin
+      if s[i]=' ' then
+        exit(copy(s,1,i-1));
+      inc(i);
+    end;
+  leftstr:=s;
+end;
+
+var
+  Line: String;
+begin
+  Line := 'astring2     ';
+  case LeftStr(Line,1) of
+    'astring1':
+      halt(1);
+    'astring2': // comment this line and everything works
+       halt(0);
+     else
+       halt(2);
+  end;
+end.
+