Quellcode durchsuchen

* bug about assigning the return value of a function to
a procvar fixed : warning
assigning a proc to a procvar need @ in FPC mode !!
* missing file/line info restored

pierre vor 27 Jahren
Ursprung
Commit
6a556346ed
5 geänderte Dateien mit 82 neuen und 13 gelöschten Zeilen
  1. 14 1
      compiler/comphook.pas
  2. 17 5
      compiler/pexpr.pas
  3. 8 2
      compiler/scanner.pas
  4. 30 2
      compiler/types.pas
  5. 13 3
      compiler/verbose.pas

+ 14 - 1
compiler/comphook.pas

@@ -201,6 +201,13 @@ begin
         else
           hs:=status.currentsource+'('+tostr(status.currentline)
               +','+tostr(status.currentcolumn)+') '+hs;
+      end
+{$ifdef Debug}
+     else
+      begin
+         if (Level<=V_ShowFile) then
+           hs:='No line '+hs;
+{$endif Debug}
       end;
    { add the message to the text }
      hs:=hs+s;
@@ -234,7 +241,13 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  1998-08-18 09:24:40  pierre
+  Revision 1.4  1998-08-18 14:17:08  pierre
+    * bug about assigning the return value of a function to
+      a procvar fixed : warning
+      assigning a proc to a procvar need @ in FPC mode !!
+    * missing file/line info restored
+
+  Revision 1.3  1998/08/18 09:24:40  pierre
     * small warning position bug fixed
     * support_mmx switches splitting was missing
     * rhide error and warning output corrected

+ 17 - 5
compiler/pexpr.pas

@@ -1011,7 +1011,7 @@ unit pexpr;
                   begin
                     if (pd^.deftype=procvardef) then
                      begin
-                       if getprocvar then
+                       if getprocvar and proc_to_procvar_equal(pprocvardef(pd),getprocvardef) then
                          again:=false
                        else
                          if (token=LKLAMMER) or
@@ -1672,7 +1672,9 @@ unit pexpr;
     begin
 {        if pred_level=high(Toperator_precedence) then }
          if pred_level=opmultiply then
-            p1:=factor(getprocvar)
+         { this IS wrong   !!! PM
+            p1:=factor(getprocvar)}
+            p1:=factor(false)
         else
             p1:=sub_expr(succ(pred_level),true);
         repeat
@@ -1739,9 +1741,13 @@ unit pexpr;
                             it must be assigned to a procvar }
                             { should be recursive for a:=b:=c !!! }
                             if (p1^.resulttype<>nil) and (p1^.resulttype^.deftype=procvardef) then
-                              getprocvar:=true;
+                              begin
+                                 getprocvar:=true;
+                                 getprocvardef:=pprocvardef(p1^.resulttype);
+                              end;
                             p2:=sub_expr(opcompare,true);
-                            if getprocvar and (p2^.treetype=calln) then
+                            if getprocvar and (p2^.treetype=calln) and
+                               (proc_to_procvar_equal(getprocvardef,pprocsym(p2^.symtableentry)^.definition)) then
                               begin
                                  p2^.treetype:=loadn;
                                  p2^.resulttype:=pprocsym(p2^.symtableprocentry)^.definition;
@@ -1829,7 +1835,13 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.37  1998-08-18 09:24:43  pierre
+  Revision 1.38  1998-08-18 14:17:09  pierre
+    * bug about assigning the return value of a function to
+      a procvar fixed : warning
+      assigning a proc to a procvar need @ in FPC mode !!
+    * missing file/line info restored
+
+  Revision 1.37  1998/08/18 09:24:43  pierre
     * small warning position bug fixed
     * support_mmx switches splitting was missing
     * rhide error and warning output corrected

+ 8 - 2
compiler/scanner.pas

@@ -630,7 +630,7 @@ implementation
         plongint(longint(linebuf)+line_no*2)^:=lastlinepos;
 {$endif SourceLine}
       { update for status and call the show status routine }
-        aktfilepos.line:=line_no; { update for v_status }
+        gettokenpos; { update for v_status }
         inc(status.compiledlines);
         ShowStatus;
       end;
@@ -1548,7 +1548,13 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.40  1998-08-11 14:04:33  peter
+  Revision 1.41  1998-08-18 14:17:10  pierre
+    * bug about assigning the return value of a function to
+      a procvar fixed : warning
+      assigning a proc to a procvar need @ in FPC mode !!
+    * missing file/line info restored
+
+  Revision 1.40  1998/08/11 14:04:33  peter
     * auto close an open file and better error msg
 
   Revision 1.39  1998/08/10 14:50:26  peter

+ 30 - 2
compiler/types.pas

@@ -81,6 +81,9 @@ unit types;
     { equal                                         }
     function equal_paras(def1,def2 : pdefcoll;value_equal_const : boolean) : boolean;
 
+    { true if a function can be assigned to a procvar }
+    function proc_to_procvar_equal(def1,def2 : pabstractprocdef) : boolean;
+
     { if l isn't in the range of def a range check error is generated }
     procedure testrange(def : pdef;l : longint);
 
@@ -136,6 +139,19 @@ unit types;
            equal_paras:=false;
       end;
 
+    { true if a function can be assigned to a procvar }
+    function proc_to_procvar_equal(def1,def2 : pabstractprocdef) : boolean;
+
+      begin
+         if is_equal(def1^.retdef,def2^.retdef) and
+            equal_paras(def1^.para1,def2^.para1,false) and
+            ((def1^.options and po_comptatibility_options)=
+             (def2^.options and po_comptatibility_options)) then
+           proc_to_procvar_equal:=true
+         else
+           proc_to_procvar_equal:=false;
+      end;
+      
     { returns true, if def uses FPU }
     function is_fpu(def : pdef) : boolean;
       begin
@@ -862,7 +878,13 @@ unit types;
 end.
 {
   $Log$
-  Revision 1.19  1998-08-18 09:24:48  pierre
+  Revision 1.20  1998-08-18 14:17:14  pierre
+    * bug about assigning the return value of a function to
+      a procvar fixed : warning
+      assigning a proc to a procvar need @ in FPC mode !!
+    * missing file/line info restored
+
+  Revision 1.19  1998/08/18 09:24:48  pierre
     * small warning position bug fixed
     * support_mmx switches splitting was missing
     * rhide error and warning output corrected
@@ -874,7 +896,13 @@ end.
   Revision 1.17  1998/08/05 16:00:17  florian
     * some fixes for ansi strings
     * $log$ to $Log$
-    * $log$ to Revision 1.19  1998-08-18 09:24:48  pierre
+    * $log$ to Revision 1.20  1998-08-18 14:17:14  pierre
+    * $log$ to   * bug about assigning the return value of a function to
+    * $log$ to     a procvar fixed : warning
+    * $log$ to     assigning a proc to a procvar need @ in FPC mode !!
+    * $log$ to   * missing file/line info restored
+    * $log$ to
+    * $log$ to Revision 1.19  1998/08/18 09:24:48  pierre
     * $log$ to   * small warning position bug fixed
     * $log$ to   * support_mmx switches splitting was missing
     * $log$ to   * rhide error and warning output corrected

+ 13 - 3
compiler/verbose.pas

@@ -227,7 +227,7 @@ begin
      ((current_module^.unit_index<>lastmoduleidx) or
       (aktfilepos.fileindex<>lastfileidx)) then
    begin
-     status.currentsource:=current_module^.sourcefiles.get_file_name(current_module^.current_index);
+     status.currentsource:=current_module^.sourcefiles.get_file_name(aktfilepos.fileindex);
      lastmoduleidx:=current_module^.unit_index;
      lastfileidx:=aktfilepos.fileindex;
    end;
@@ -335,7 +335,11 @@ begin
    begin
      status.currentsource:=current_module^.sourcefiles.get_file_name(aktfilepos.fileindex);
      lastmoduleidx:=current_module^.unit_index;
-     lastfileidx:=aktfilepos.fileindex;
+     { update lastfileidx only if name known PM }
+     if status.currentsource<>'' then
+       lastfileidx:=aktfilepos.fileindex
+     else
+       lastfileidx:=0;
    end;
 { show comment }
   if do_comment(v,s) or dostop or (status.errorcount>=status.maxerrorcount) then
@@ -385,7 +389,13 @@ end.
 
 {
   $Log$
-  Revision 1.15  1998-08-18 09:24:49  pierre
+  Revision 1.16  1998-08-18 14:17:15  pierre
+    * bug about assigning the return value of a function to
+      a procvar fixed : warning
+      assigning a proc to a procvar need @ in FPC mode !!
+    * missing file/line info restored
+
+  Revision 1.15  1998/08/18 09:24:49  pierre
     * small warning position bug fixed
     * support_mmx switches splitting was missing
     * rhide error and warning output corrected