浏览代码

* also check that nested procedures don't have any nested procedures
of their own that are marked as inline, instead of only doing so
for non-nested procedures (mantis #13553)

git-svn-id: trunk@13025 -

Jonas Maebe 16 年之前
父节点
当前提交
2465126f60
共有 3 个文件被更改,包括 103 次插入15 次删除
  1. 1 0
      .gitattributes
  2. 16 15
      compiler/psub.pas
  3. 86 0
      tests/webtbs/tw13553.pp

+ 1 - 0
.gitattributes

@@ -8822,6 +8822,7 @@ tests/webtbs/tw13456.pp svneol=native#text/plain
 tests/webtbs/tw1348.pp svneol=native#text/plain
 tests/webtbs/tw1348.pp svneol=native#text/plain
 tests/webtbs/tw1351.pp svneol=native#text/plain
 tests/webtbs/tw1351.pp svneol=native#text/plain
 tests/webtbs/tw13536.pp svneol=native#text/plain
 tests/webtbs/tw13536.pp svneol=native#text/plain
+tests/webtbs/tw13553.pp svneol=native#text/plain
 tests/webtbs/tw1364.pp svneol=native#text/plain
 tests/webtbs/tw1364.pp svneol=native#text/plain
 tests/webtbs/tw1365.pp svneol=native#text/plain
 tests/webtbs/tw1365.pp svneol=native#text/plain
 tests/webtbs/tw1374.pp svneol=native#text/plain
 tests/webtbs/tw1374.pp svneol=native#text/plain

+ 16 - 15
compiler/psub.pas

@@ -1481,6 +1481,22 @@ implementation
 
 
         tcgprocinfo(current_procinfo).parse_body;
         tcgprocinfo(current_procinfo).parse_body;
 
 
+        { We can't support inlining for procedures that have nested
+          procedures because the nested procedures use a fixed offset
+          for accessing locals in the parent procedure (PFV) }
+        if (tcgprocinfo(current_procinfo).nestedprocs.count>0) then
+          begin
+            if (df_generic in current_procinfo.procdef.defoptions) then
+              Comment(V_Error,'Generic methods cannot have nested procedures')
+            else
+             if (po_inline in current_procinfo.procdef.procoptions) then
+              begin
+                Message1(parser_w_not_supported_for_inline,'nested procedures');
+                Message(parser_w_inlining_disabled);
+                exclude(current_procinfo.procdef.procoptions,po_inline);
+              end;
+          end;
+
         { When it's a nested procedure then defer the code generation,
         { When it's a nested procedure then defer the code generation,
           when back at normal function level then generate the code
           when back at normal function level then generate the code
           for all defered nested procedures and the current procedure }
           for all defered nested procedures and the current procedure }
@@ -1488,21 +1504,6 @@ implementation
           tcgprocinfo(current_procinfo.parent).nestedprocs.insert(current_procinfo)
           tcgprocinfo(current_procinfo.parent).nestedprocs.insert(current_procinfo)
         else
         else
           begin
           begin
-            { We can't support inlining for procedures that have nested
-              procedures because the nested procedures use a fixed offset
-              for accessing locals in the parent procedure (PFV) }
-            if (tcgprocinfo(current_procinfo).nestedprocs.count>0) then
-              begin
-                if (df_generic in current_procinfo.procdef.defoptions) then
-                  Comment(V_Error,'Generic methods cannot have nested procedures')
-                else
-                 if (po_inline in current_procinfo.procdef.procoptions) then
-                  begin
-                    Message1(parser_w_not_supported_for_inline,'nested procedures');
-                    Message(parser_w_inlining_disabled);
-                    exclude(current_procinfo.procdef.procoptions,po_inline);
-                  end;
-              end;
             if not(df_generic in current_procinfo.procdef.defoptions) then
             if not(df_generic in current_procinfo.procdef.defoptions) then
               do_generate_code(tcgprocinfo(current_procinfo));
               do_generate_code(tcgprocinfo(current_procinfo));
           end;
           end;

+ 86 - 0
tests/webtbs/tw13553.pp

@@ -0,0 +1,86 @@
+unit tw13553;
+
+interface
+
+type
+  TSymbol = (smNumber,smAdd,smSub,smMul,smDiv,smPow);
+
+var
+  Symbol: TSymbol;
+  Number: Extended;
+
+function NextToken: Boolean;
+
+implementation
+
+function NextToken: Boolean;
+var
+  c: Char;
+
+  procedure GetChar; inline;
+  begin
+    Read(Input,c);
+  end;
+
+  procedure SkipWhite; inline;
+  begin
+    while c<=' ' do GetChar;
+  end;
+
+  procedure GetNumber; inline;
+
+    function CharToNum(const c: Char): Byte; inline;
+    begin
+      CharToNum:=Ord(c)-Ord('0');
+    end;
+
+  var
+    Divisor: LongWord;
+  begin
+    Number:=CharToNum(c);
+    GetChar;
+    while c in ['0'..'9'] do begin
+      Number:=Number*10+CharToNum(c);
+      GetChar;
+    end;
+    if c='.' then begin
+      GetChar;
+      Divisor:=10;
+      while c in ['0'..'9'] do begin
+        Number:=Number+CharToNum(c)/Divisor;
+        Divisor:=Divisor*10;
+        GetChar;
+      end;
+    end;
+  end;
+
+begin
+  NextToken:=true;
+  if not EOF then begin
+    SkipWhite;
+    case c of
+      '0'..'9': begin
+        Symbol:=smNumber;
+        GetNumber;
+      end;
+      '+': begin
+        Symbol:=smAdd;
+      end;
+      '-': begin
+        Symbol:=smSub;
+      end;
+      '*': begin
+        Symbol:=smMul;
+      end;
+      '/': begin
+        Symbol:=smDiv;
+      end;
+      '^': begin
+        Symbol:=smPow;
+      end;
+    end;
+  end else
+    NextToken:=false;
+end;
+
+end.