Bläddra i källkod

* use myexit to restore block_type

git-svn-id: trunk@1062 -
peter 20 år sedan
förälder
incheckning
26f25c89ee
3 ändrade filer med 30 tillägg och 5 borttagningar
  1. 1 0
      .gitattributes
  2. 7 5
      compiler/ptconst.pas
  3. 22 0
      tests/webtbs/tw4350.pp

+ 1 - 0
.gitattributes

@@ -6212,6 +6212,7 @@ tests/webtbs/tw4277.pp svneol=native#text/plain
 tests/webtbs/tw4294.pp svneol=native#text/plain
 tests/webtbs/tw4308.pp svneol=native#text/plain
 tests/webtbs/tw4336.pp svneol=native#text/plain
+tests/webtbs/tw4350.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

+ 7 - 5
compiler/ptconst.pas

@@ -54,7 +54,8 @@ implementation
 {$endif fpc}
     { this procedure reads typed constants }
     procedure readtypedconst(const t:ttype;sym : ttypedconstsym;writable : boolean);
-
+      label
+         myexit;
       type
          setbytes = array[0..31] of byte;
          Psetbytes = ^setbytes;
@@ -732,7 +733,7 @@ implementation
                    if (po_methodpointer in tprocvardef(t.def).procoptions) then
                      asmlist[cural].concat(Tai_const.Create_sym(nil));
                    consume(_NIL);
-                   exit;
+                   goto myexit;
                 end;
               { you can't assign a value other than NIL to a typed constant  }
               { which is a "procedure of object", because this also requires }
@@ -747,14 +748,14 @@ implementation
               if codegenerror then
                begin
                  p.free;
-                 exit;
+                 goto myexit;
                end;
               { let type conversion check everything needed }
               inserttypeconv(p,t);
               if codegenerror then
                begin
                  p.free;
-                 exit;
+                 goto myexit;
                end;
               { remove typeconvs, that will normally insert a lea
                 instruction which is not necessary for us }
@@ -812,7 +813,7 @@ implementation
                     begin
                       p.free;
                       Message(parser_e_illegal_expression);
-                      exit;
+                      goto myexit;
                     end;
                 end
               else
@@ -1026,6 +1027,7 @@ implementation
            end;
          else Message(parser_e_type_const_not_possible);
          end;
+      myexit:
          block_type:=old_block_type;
       end;
 {$ifdef fpc}

+ 22 - 0
tests/webtbs/tw4350.pp

@@ -0,0 +1,22 @@
+{$mode delphi}
+
+unit tw4350;
+
+interface
+
+uses
+  Classes;
+
+type
+  TIdStackSocketHandle = integer ;// class end;
+  TIdServeFile = function(ASocket: TIdStackSocketHandle; AFileName: string): cardinal;
+  TIdStackBSDBase = Class
+                      end;
+
+var
+  GServeFileProc: TIdServeFile = nil; // comment either, and the other line works?
+  GBSDStack: TIdStackBSDBase = nil;
+
+implementation
+
+end.