* bug exit('test') + fail for classes

compiler/cg386flw.pas

@@ -389,6 +389,13 @@ implementation
          do_jmp;
       begin
          if assigned(p^.left) then
+         if p^.left^.treetype=assignn then
+           begin
+              { just do a normal assignment followed by exit }
+              secondpass(p^.left);
+              emitjmp(C_None,aktexitlabel);
+           end
+         else
            begin
               otlabel:=truelabel;
               oflabel:=falselabel;
@@ -811,7 +818,10 @@ do_jmp:
 end.
 {
   $Log$
-  Revision 1.52  1999-09-27 23:44:46  peter
+  Revision 1.53  1999-10-05 22:01:52  pierre
+   * bug exit('test') + fail for classes
+
+  Revision 1.52  1999/09/27 23:44:46  peter
     * procinfo is now a pointer
     * support for result setting in sub procedure
 
@@ -1011,4 +1021,3 @@ end.
     * splitted cgi386
 
 }
-

compiler/cgai386.pas

@@ -3223,10 +3223,19 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                   getlabel(okexitlabel);
                   emitjmp(C_NONE,okexitlabel);
                   emitlab(faillabel);
-                  emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,12),R_ESI);
-                  emit_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI);
-                  emitcall('FPC_HELP_FAIL');
+                  if procinfo^._class^.is_class then
+                    begin
+                      emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,8),R_ESI);
+                      emitcall('FPC_HELP_FAIL_CLASS');
+                    end
+                  else
+                    begin
+                      emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,12),R_ESI);
+                      emit_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI);
+                      emitcall('FPC_HELP_FAIL');
+                    end;
                   emitlab(okexitlabel);
+
                   emit_reg_reg(A_MOV,S_L,R_ESI,R_EAX);
                   emit_reg_reg(A_OR,S_L,R_EAX,R_EAX);
               end;
@@ -3377,7 +3386,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 end.
 {
   $Log$
-  Revision 1.50  1999-09-29 11:46:18  florian
+  Revision 1.51  1999-10-05 22:01:52  pierre
+   * bug exit('test') + fail for classes
+
+  Revision 1.50  1999/09/29 11:46:18  florian
     * fixed bug 292 from bugs directory
 
   Revision 1.49  1999/09/28 21:07:53  florian

compiler/tcflw.pas

@@ -322,6 +322,8 @@ implementation
 *****************************************************************************}
 
     procedure firstexit(var p : ptree);
+      var
+         pt : ptree;
       begin
          if assigned(p^.left) then
            begin
@@ -332,6 +334,14 @@ implementation
               { Check the 2 types }
               p^.left:=gentypeconvnode(p^.left,p^.resulttype);
               firstpass(p^.left);
+              if ret_in_param(p^.resulttype) then
+                begin
+                  pt:=genzeronode(funcretn);
+                  pt^.retdef:=p^.resulttype;
+                  pt^.funcretprocinfo:=procinfo; 
+                  p^.left:=gennode(assignn,pt,p^.left);
+                  firstpass(p^.left);
+                end;
               p^.registers32:=p^.left^.registers32;
               p^.registersfpu:=p^.left^.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -497,7 +507,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.22  1999-10-04 20:27:41  peter
+  Revision 1.23  1999-10-05 22:01:53  pierre
+   * bug exit('test') + fail for classes
+
+  Revision 1.22  1999/10/04 20:27:41  peter
     * fixed first pass for if branches if the expression got an error
 
   Revision 1.20  1999/09/27 23:45:01  peter