Browse Source

* 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 năm trước cách đây
mục cha
commit
2465126f60
3 tập tin đã thay đổi với 103 bổ sung15 xóa
  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.