* fixed dup release of statement label in case

compiler/pstatmnt.pas

@@ -129,12 +129,13 @@ unit pstatmnt;
       var
          { contains the label number of currently parsed case block }
          aktcaselabel : plabel;
+         firstlabel : boolean;
          root : pcaserecord;
 
          { the typ of the case expression }
          casedef : pdef;
 
-      procedure newcaselabel(l,h : longint);
+      procedure newcaselabel(l,h : longint;first:boolean);
 
         var
            hcaselabel : pcaserecord;
@@ -158,6 +159,7 @@ unit pstatmnt;
            hcaselabel^.less:=nil;
            hcaselabel^.greater:=nil;
            hcaselabel^.statement:=aktcaselabel;
+           hcaselabel^.firstlabel:=first;
            getlabel(hcaselabel^._at);
            hcaselabel^._low:=l;
            hcaselabel^._high:=h;
@@ -167,7 +169,6 @@ unit pstatmnt;
       var
          code,caseexpr,p,instruc,elseblock : ptree;
          hl1,hl2 : longint;
-         ranges : boolean;
 
       begin
          consume(_CASE);
@@ -182,11 +183,10 @@ unit pstatmnt;
          consume(_OF);
          inc(statement_level);
          root:=nil;
-         ranges:=false;
          instruc:=nil;
          repeat
            getlabel(aktcaselabel);
-           {aktcaselabel^.is_used:=true; }
+           firstlabel:=true;
 
            { may be an instruction has more case labels }
            repeat
@@ -206,21 +206,23 @@ unit pstatmnt;
                   hl2:=get_ordinal_value(p^.right);
                   testrange(casedef,hl1);
                   testrange(casedef,hl2);
-                  newcaselabel(hl1,hl2);
-                  ranges:=true;
+                  newcaselabel(hl1,hl2,firstlabel);
                end
              else
                begin
                   { type checking for case statements }
                   if not is_subequal(casedef, p^.resulttype) then
                     Message(parser_e_case_mismatch);
-                    hl1:=get_ordinal_value(p);
-                    testrange(casedef,hl1);
-                    newcaselabel(hl1,hl1);
+                  hl1:=get_ordinal_value(p);
+                  testrange(casedef,hl1);
+                  newcaselabel(hl1,hl1,firstlabel);
                end;
              disposetree(p);
-             if token=COMMA then consume(COMMA)
-               else break;
+             if token=COMMA then
+               consume(COMMA)
+             else
+               break;
+             firstlabel:=false;
            until false;
            consume(COLON);
 
@@ -1225,7 +1227,10 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.52  1998-12-11 00:03:37  peter
+  Revision 1.53  1998-12-15 11:52:18  peter
+    * fixed dup release of statement label in case
+
+  Revision 1.52  1998/12/11 00:03:37  peter
     + globtype,tokens,version unit splitted from globals
 
   Revision 1.51  1998/12/10 09:47:24  florian

compiler/tree.pas

@@ -203,6 +203,10 @@ unit tree;
           { label of instruction }
           statement : plabel;
 
+          { is this the first of an case entry, needed to release statement
+            label (PFV) }
+          firstlabel : boolean;
+
           { left and right tree node }
           less,greater : pcaserecord;
        end;
@@ -453,9 +457,9 @@ unit tree;
          if assigned(p^.less) then
            deletecaselabels(p^.less);
          freelabel(p^._at);
-         freelabel(p^.statement);
+         if p^.firstlabel then
+          freelabel(p^.statement);
          dispose(p);
-         p:=nil;
       end;
 
     procedure swaptree(p:Ptree);
@@ -1657,7 +1661,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.59  1998-12-15 10:23:32  peter
+  Revision 1.60  1998-12-15 11:52:19  peter
+    * fixed dup release of statement label in case
+
+  Revision 1.59  1998/12/15 10:23:32  peter
     + -iSO, -iSP, -iTO, -iTP
 
   Revision 1.58  1998/12/11 00:04:02  peter