* procvar directive parsing fixes

compiler/pdecl.pas

@@ -202,11 +202,13 @@ implementation
                    if (tt.def.deftype=procvardef) then
                     begin
                       { support p : procedure;stdcall=nil; }
-                      if (token=_SEMICOLON) then
+                      if try_to_consume(_SEMICOLON) then
                        begin
-                         consume(_SEMICOLON);
-                         if is_proc_directive(token) then
-                          parse_var_proc_directives(sym)
+                         if is_proc_directive(token,true) then
+                          begin
+                            parse_var_proc_directives(sym);
+                            handle_calling_convention(tprocvardef(tt.def));
+                          end
                          else
                           begin
                             Message(parser_e_proc_directive_expected);
@@ -216,7 +218,7 @@ implementation
                       else
                       { support p : procedure stdcall=nil; }
                        begin
-                         if is_proc_directive(token) then
+                         if is_proc_directive(token,true) then
                           parse_var_proc_directives(sym);
                        end;
                       { add default calling convention }
@@ -489,7 +491,7 @@ implementation
                      consume(_SEMICOLON)
                     else
                      begin
-                       if not is_proc_directive(token) then
+                       if not is_proc_directive(token,true) then
                         consume(_SEMICOLON);
                        parse_var_proc_directives(tsym(newtype));
                      end;
@@ -633,7 +635,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.69  2003-09-23 17:56:05  peter
+  Revision 1.70  2003-10-02 21:13:09  peter
+    * procvar directive parsing fixes
+
+  Revision 1.69  2003/09/23 17:56:05  peter
     * locals and paras are allocated in the code generation
     * tvarsym.localloc contains the location of para/local when
       generating code for the current procedure

compiler/pdecsub.pas

@@ -37,11 +37,12 @@ interface
         pd_object,     { directive can be used object declaration }
         pd_procvar,    { directive can be used procvar declaration }
         pd_notobject,  { directive can not be used object declaration }
-        pd_notobjintf  { directive can not be used interface declaration }
+        pd_notobjintf, { directive can not be used interface declaration }
+        pd_notprocvar  { directive can not be used procvar declaration }
       );
       tpdflags=set of tpdflag;
 
-    function  is_proc_directive(tok:ttoken):boolean;
+    function is_proc_directive(tok:ttoken;isprocvar:boolean):boolean;
 
     procedure calc_parast(pd:tabstractprocdef);
 
@@ -884,10 +885,9 @@ implementation
                 end;
             end;
         end;
-        { support procedure proc;stdcall export; in Delphi mode only }
-        if not((m_delphi in aktmodeswitches) and
-           is_proc_directive(token)) then
-         consume(_SEMICOLON);
+        { support procedure proc stdcall export; }
+        if not(is_proc_directive(token,false)) then
+          consume(_SEMICOLON);
         result:=pd;
       end;
 
@@ -1197,7 +1197,7 @@ const
       pocall   : pocall_none;
       pooption : [po_abstractmethod];
       mutexclpocall : [pocall_internproc,pocall_inline];
-      mutexclpotype : [potype_constructor,potype_destructor];
+      mutexclpotype : [];
       mutexclpo     : [po_exports,po_interrupt,po_external]
     ),(
       idtok:_ALIAS;
@@ -1502,7 +1502,7 @@ const
    );
 
 
-    function is_proc_directive(tok:ttoken):boolean;
+    function is_proc_directive(tok:ttoken;isprocvar:boolean):boolean;
       var
         i : longint;
       begin
@@ -1510,7 +1510,9 @@ const
         for i:=1 to num_proc_directives do
          if proc_direcdata[i].idtok=idtoken then
           begin
-            is_proc_directive:=true;
+            if (not isprocvar) or
+               (pd_procvar in proc_direcdata[i].pd_flags) then
+              is_proc_directive:=true;
             exit;
           end;
       end;
@@ -1818,22 +1820,21 @@ const
             begin
               res:=parse_proc_direc(pd,pdflags);
             end;
-         { A procedure directive normally followed by a semicolon, but in
-           a const section we should stop when _EQUAL is found }
+           { A procedure directive normally followed by a semicolon, but in
+             a const section or reading a type we should stop when _EQUAL is found,
+             because a constant/default value follows }
            if res then
             begin
-              if (block_type=bt_const) and
+              if (block_type in [bt_const,bt_type]) and
                  (token=_EQUAL) then
                break;
-              { support procedure proc;stdcall export; in Delphi mode only }
-              if not((m_delphi in aktmodeswitches) and
-                     is_proc_directive(token)) then
+              { support procedure proc;stdcall export; }
+              if not(is_proc_directive(token,(pd.deftype=procvardef))) then
                consume(_SEMICOLON);
             end
            else
             break;
          end;
-        handle_calling_convention(pd);
       end;
 
 
@@ -2111,8 +2112,9 @@ const
                   (po_overload in hd.procoptions)) then
                begin
                  { check if all procs have overloading, but not if the proc was
-                   already declared forward, then the check is already done }
+                   already declared forward or abstract, then the check is already done }
                  if not(hd.hasforward or
+                        (po_abstractmethod in hd.procoptions) or
                         (pd.forwarddef<>hd.forwarddef) or
                         ((po_overload in pd.procoptions) and
                          (po_overload in hd.procoptions))) then
@@ -2149,7 +2151,10 @@ const
 end.
 {
   $Log$
-  Revision 1.142  2003-10-01 19:05:33  peter
+  Revision 1.143  2003-10-02 21:13:09  peter
+    * procvar directive parsing fixes
+
+  Revision 1.142  2003/10/01 19:05:33  peter
     * searchsym_type to search for type definitions. It ignores
       records,objects and parameters
 

compiler/pdecvar.pas

@@ -303,41 +303,68 @@ implementation
                 pt.free;
                 symdone:=true;
               end;
-             { Handling of Delphi typed const = initialized vars ! }
-             { When should this be rejected ?
-               - in parasymtable
-               - in record or object
-               - ... (PM) }
-             if (token=_EQUAL) and
-                not(m_tp7 in aktmodeswitches) and
-                not(symtablestack.symtabletype in [parasymtable]) and
-                not is_record and
-                not is_object then
+             { Records and objects can't have default values }
+             if is_record or is_object then
                begin
-                  vs:=tvarsym(sc.first);
-                  if assigned(vs.listnext) then
-                    Message(parser_e_initialized_only_one_var);
-                  if is_threadvar then
-                    Message(parser_e_initialized_not_for_threadvar);
-                  if symtablestack.symtabletype=localsymtable then
+                 { for a record there doesn't need to be a ; before the END or ) }
+                 if not(token in [_END,_RKLAMMER]) then
+                   consume(_SEMICOLON);
+               end
+             else
+               begin
+                 { Process procvar directives before = and ; }
+                 if (tt.def.deftype=procvardef) and
+                    (tt.def.typesym=nil) and
+                    is_proc_directive(token,true) then
                    begin
-                     consume(_EQUAL);
-                     tconstsym:=ttypedconstsym.createtype('default'+vs.realname,tt,false);
-                     vs.defaultconstsym:=tconstsym;
-                     symtablestack.insert(tconstsym);
-                     insertconstdata(tconstsym);
-                     readtypedconst(tt,tconstsym,false);
+                      newtype:=ttypesym.create('unnamed',tt);
+                      parse_var_proc_directives(tsym(newtype));
+                      newtype.restype.def:=nil;
+                      tt.def.typesym:=nil;
+                      newtype.free;
+                   end;
+
+                 { Handling of Delphi typed const = initialized vars ! }
+                 { When should this be rejected ?
+                   - in parasymtable
+                   - in record or object
+                   - ... (PM) }
+                 if (token=_EQUAL) and
+                    not(m_tp7 in aktmodeswitches) and
+                    not(symtablestack.symtabletype in [parasymtable]) and
+                    not is_record and
+                    not is_object then
+                   begin
+                      vs:=tvarsym(sc.first);
+                      if assigned(vs.listnext) then
+                        Message(parser_e_initialized_only_one_var);
+                      if is_threadvar then
+                        Message(parser_e_initialized_not_for_threadvar);
+                      if symtablestack.symtabletype=localsymtable then
+                       begin
+                         consume(_EQUAL);
+                         tconstsym:=ttypedconstsym.createtype('default'+vs.realname,tt,false);
+                         vs.defaultconstsym:=tconstsym;
+                         symtablestack.insert(tconstsym);
+                         insertconstdata(tconstsym);
+                         readtypedconst(tt,tconstsym,false);
+                       end
+                      else
+                       begin
+                         tconstsym:=ttypedconstsym.createtype(vs.realname,tt,true);
+                         tconstsym.fileinfo:=vs.fileinfo;
+                         symtablestack.replace(vs,tconstsym);
+                         vs.free;
+                         insertconstdata(tconstsym);
+                         consume(_EQUAL);
+                         readtypedconst(tt,tconstsym,true);
+                         symdone:=true;
+                         consume(_SEMICOLON);
+                       end
                    end
-                  else
+                 else
                    begin
-                     tconstsym:=ttypedconstsym.createtype(vs.realname,tt,true);
-                     tconstsym.fileinfo:=vs.fileinfo;
-                     symtablestack.replace(vs,tconstsym);
-                     vs.free;
-                     insertconstdata(tconstsym);
-                     consume(_EQUAL);
-                     readtypedconst(tt,tconstsym,true);
-                     symdone:=true;
+                     consume(_SEMICOLON);
                    end;
                end;
              { if the symbol is not completely handled, then try to parse the
@@ -347,18 +374,21 @@ implementation
                  dummysymoptions:=[];
                  try_consume_hintdirective(dummysymoptions);
                end;
-             { for a record there doesn't need to be a ; before the END or ) }
-             if not((is_record or is_object) and (token in [_END,_RKLAMMER])) then
-               consume(_SEMICOLON);
-             { procvar handling }
-             if (tt.def.deftype=procvardef) and (tt.def.typesym=nil) then
+             { Parse procvar directives after ; }
+             if (tt.def.deftype=procvardef) and
+                (tt.def.typesym=nil) then
                begin
-                  newtype:=ttypesym.create('unnamed',tt);
-                  parse_var_proc_directives(tsym(newtype));
-                  newtype.restype.def:=nil;
-                  tt.def.typesym:=nil;
-                  newtype.free;
-               end;
+                 if is_proc_directive(token,true) then
+                   begin
+                     newtype:=ttypesym.create('unnamed',tt);
+                     parse_var_proc_directives(tsym(newtype));
+                     newtype.restype.def:=nil;
+                     tt.def.typesym:=nil;
+                     newtype.free;
+                   end;
+                 { Add calling convention for procvar }
+                 handle_calling_convention(tprocvardef(tt.def));
+              end;
              { Check for variable directives }
              if not symdone and (token=_ID) then
               begin
@@ -617,7 +647,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.53  2003-10-02 15:12:07  peter
+  Revision 1.54  2003-10-02 21:13:09  peter
+    * procvar directive parsing fixes
+
+  Revision 1.53  2003/10/02 15:12:07  peter
     * fix type parsing in records
 
   Revision 1.52  2003/10/01 19:05:33  peter

compiler/ptype.pas

@@ -459,6 +459,7 @@ implementation
         pd : tabstractprocdef;
         is_func,
         enumdupmsg : boolean;
+        newtype : ttypesym;
       begin
          tt.reset;
          case token of
@@ -615,9 +616,19 @@ implementation
                     consume(_OBJECT);
                     include(pd.procoptions,po_methodpointer);
                   end;
+                tt.def:=pd;
+                { possible proc directives }
+                if is_proc_directive(token,true) then
+                  begin
+                     newtype:=ttypesym.create('unnamed',tt);
+                     parse_var_proc_directives(tsym(newtype));
+                     newtype.restype.def:=nil;
+                     tt.def.typesym:=nil;
+                     newtype.free;
+                  end;
                 { Add implicit hidden parameters and function result }
+                handle_calling_convention(pd);
                 calc_parast(pd);
-                tt.def:=pd;
               end;
             else
               expr_type;
@@ -629,7 +640,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.57  2003-10-01 19:05:33  peter
+  Revision 1.58  2003-10-02 21:13:09  peter
+    * procvar directive parsing fixes
+
+  Revision 1.57  2003/10/01 19:05:33  peter
     * searchsym_type to search for type definitions. It ignores
       records,objects and parameters