pdecsub.pas:

  * move handling after parsing a procedure's/function's/method's name and its parameters from parse_proc_dec() into a new function parse_proc_dec_finish(), so that it can be used for generic functions/methods in the future

git-svn-id: trunk@31509 -

compiler/pdecsub.pas

@@ -1101,13 +1101,11 @@ implementation
       end;
 
 
-    function parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
+    procedure parse_proc_dec_finish(pd:tprocdef;isclassmethod:boolean);
       var
-        pd: tprocdef;
         locationstr: string;
         i: integer;
         found: boolean;
-        old_block_type: tblock_type;
 
         procedure read_returndef(pd: tprocdef);
           var
@@ -1164,7 +1162,190 @@ implementation
 
       begin
         locationstr:='';
+        case pd.proctypeoption of
+          potype_procedure:
+            begin
+              pd.returndef:=voidtype;
+              if isclassmethod then
+                include(pd.procoptions,po_classmethod);
+            end;
+          potype_function:
+            begin
+              if try_to_consume(_COLON) then
+               begin
+                 read_returndef(pd);
+                 if (target_info.system in [system_m68k_amiga]) then
+                  begin
+                   if (idtoken=_LOCATION) then
+                    begin
+                     if po_explicitparaloc in pd.procoptions then
+                      begin
+                       consume(_LOCATION);
+                       locationstr:=cstringpattern;
+                       consume(_CSTRING);
+                      end
+                     else
+                      { I guess this needs a new message... (KB) }
+                      Message(parser_e_paraloc_all_paras);
+                    end
+                   else
+                    begin
+                     if po_explicitparaloc in pd.procoptions then
+                      { assign default locationstr, if none specified }
+                      { and we've arguments with explicit paraloc }
+                      locationstr:='D0';
+                    end;
+                  end;
+
+               end
+              else
+               begin
+                  if (
+                      parse_only and
+                      not(is_interface(pd.struct))
+                     ) or
+                     (m_repeat_forward in current_settings.modeswitches) then
+                  begin
+                    consume(_COLON);
+                    consume_all_until(_SEMICOLON);
+                  end;
+               end;
+              if isclassmethod then
+               include(pd.procoptions,po_classmethod);
+            end;
+          potype_constructor,
+          potype_class_constructor:
+            begin
+              if not isclassmethod and
+                 assigned(pd) and
+                 assigned(pd.struct) then
+                begin
+                  { Set return type, class constructors return the
+                    created instance, object constructors return boolean }
+                  if is_class(pd.struct) or
+                     is_record(pd.struct) or
+                     is_javaclass(pd.struct) then
+                    pd.returndef:=pd.struct
+                  else
+                    if is_objectpascal_helper(pd.struct) then
+                      pd.returndef:=tobjectdef(pd.struct).extendeddef
+                    else
+{$ifdef CPU64bitaddr}
+                      pd.returndef:=bool64type;
+{$else CPU64bitaddr}
+                      pd.returndef:=bool32type;
+{$endif CPU64bitaddr}
+                end
+              else
+                pd.returndef:=voidtype;
+            end;
+          potype_class_destructor,
+          potype_destructor:
+            begin
+              if assigned(pd) then
+                pd.returndef:=voidtype;
+            end;
+          potype_operator:
+            begin
+              { operators always need to be searched in all units (that
+                contain operators) }
+              include(pd.procoptions,po_overload);
+              pd.procsym.owner.includeoption(sto_has_operator);
+              if pd.parast.symtablelevel>normal_function_level then
+                Message(parser_e_no_local_operator);
+              if isclassmethod then
+                include(pd.procoptions,po_classmethod);
+              if token<>_ID then
+                begin
+                   if not(m_result in current_settings.modeswitches) then
+                     consume(_ID);
+                end
+              else
+                begin
+                  pd.resultname:=stringdup(orgpattern);
+                  consume(_ID);
+                end;
+              if not try_to_consume(_COLON) then
+                begin
+                  consume(_COLON);
+                  pd.returndef:=generrordef;
+                  consume_all_until(_SEMICOLON);
+                end
+              else
+               begin
+                 read_returndef(pd);
+                 { check that class operators have either return type of structure or }
+                 { at least one argument of that type                                 }
+                 if (po_classmethod in pd.procoptions) and
+                    (pd.returndef <> pd.struct) then
+                   begin
+                     found:=false;
+                     for i := 0 to pd.parast.SymList.Count - 1 do
+                       if tparavarsym(pd.parast.SymList[i]).vardef=pd.struct then
+                         begin
+                           found:=true;
+                           break;
+                         end;
+                     if not found then
+                       if assigned(pd.struct) then
+                         Message1(parser_e_at_least_one_argument_must_be_of_type,pd.struct.RttiName)
+                       else
+                         MessagePos(pd.fileinfo,type_e_type_id_expected);
+                   end;
+                 if (optoken in [_ASSIGNMENT,_OP_EXPLICIT]) and
+                    equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) and
+                    (pd.returndef.typ<>undefineddef) and (tparavarsym(pd.parast.SymList[0]).vardef.typ<>undefineddef) then
+                   message(parser_e_no_such_assignment)
+                 else if not isoperatoracceptable(pd,optoken) then
+                   Message(parser_e_overload_impossible);
+               end;
+            end;
+          else
+            internalerror(2015052202);
+        end;
+
+        { file types can't be function results }
+        if assigned(pd) and
+           (pd.returndef.typ=filedef) then
+          message(parser_e_illegal_function_result);
+        { support procedure proc stdcall export; }
+        if not(check_proc_directive(false)) then
+          begin
+            if (token=_COLON) and not(Assigned(pd) and is_void(pd.returndef)) then
+              begin
+                message(parser_e_field_not_allowed_here);
+                consume_all_until(_SEMICOLON);
+              end;
+            consume(_SEMICOLON);
+          end;
+
+        if locationstr<>'' then
+         begin
+           if not(paramanager.parsefuncretloc(pd,upper(locationstr))) then
+             { I guess this needs a new message... (KB) }
+             message(parser_e_illegal_explicit_paraloc);
+         end;
+      end;
+
+    function parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
+      var
+        pd : tprocdef;
+        old_block_type : tblock_type;
+        recover : boolean;
+
+        procedure finish_intf_mapping;
+          begin
+            if token=_COLON then
+              begin
+                message(parser_e_field_not_allowed_here);
+                consume_all_until(_SEMICOLON);
+              end;
+            consume(_SEMICOLON);
+          end;
+
+      begin
         pd:=nil;
+        recover:=false;
         case token of
           _FUNCTION :
             begin
@@ -1173,55 +1354,16 @@ implementation
                 begin
                   { pd=nil when it is a interface mapping }
                   if assigned(pd) then
-                    begin
-                      if try_to_consume(_COLON) then
-                       begin
-                         read_returndef(pd);
-                         if (target_info.system in [system_m68k_amiga]) then
-                          begin
-                           if (idtoken=_LOCATION) then
-                            begin
-                             if po_explicitparaloc in pd.procoptions then
-                              begin
-                               consume(_LOCATION);
-                               locationstr:=cstringpattern;
-                               consume(_CSTRING);
-                              end
-                             else
-                              { I guess this needs a new message... (KB) }
-                              Message(parser_e_paraloc_all_paras);
-                            end
-                           else
-                            begin
-                             if po_explicitparaloc in pd.procoptions then
-                              { assign default locationstr, if none specified }
-                              { and we've arguments with explicit paraloc }
-                              locationstr:='D0';
-                            end;
-                          end;
-
-                       end
-                      else
-                       begin
-                          if (
-                              parse_only and
-                              not(is_interface(pd.struct))
-                             ) or
-                             (m_repeat_forward in current_settings.modeswitches) then
-                          begin
-                            consume(_COLON);
-                            consume_all_until(_SEMICOLON);
-                          end;
-                       end;
-                      if isclassmethod then
-                       include(pd.procoptions,po_classmethod);
-                    end;
+                    parse_proc_dec_finish(pd,isclassmethod)
+                  else
+                    finish_intf_mapping;
                 end
               else
                 begin
                   { recover }
                   consume(_COLON);
                   consume_all_until(_SEMICOLON);
+                  recover:=true;
                 end;
             end;
 
@@ -1232,54 +1374,34 @@ implementation
                 begin
                   { pd=nil when it is an interface mapping }
                   if assigned(pd) then
-                    begin
-                      pd.returndef:=voidtype;
-                      if isclassmethod then
-                        include(pd.procoptions,po_classmethod);
-                    end;
-                end;
+                    parse_proc_dec_finish(pd,isclassmethod)
+                  else
+                    finish_intf_mapping;
+                end
+              else
+                recover:=true;
             end;
 
           _CONSTRUCTOR :
             begin
               consume(_CONSTRUCTOR);
               if isclassmethod then
-                parse_proc_head(astruct,potype_class_constructor,pd)
-              else
-                parse_proc_head(astruct,potype_constructor,pd);
-              if not isclassmethod and
-                 assigned(pd) and
-                 assigned(pd.struct) then
-                begin
-                  { Set return type, class constructors return the
-                    created instance, object constructors return boolean }
-                  if is_class(pd.struct) or
-                     is_record(pd.struct) or
-                     is_javaclass(pd.struct) then
-                    pd.returndef:=pd.struct
-                  else
-                    if is_objectpascal_helper(pd.struct) then
-                      pd.returndef:=tobjectdef(pd.struct).extendeddef
-                    else
-{$ifdef CPU64bitaddr}
-                      pd.returndef:=bool64type;
-{$else CPU64bitaddr}
-                      pd.returndef:=bool32type;
-{$endif CPU64bitaddr}
-                end
+                recover:=not parse_proc_head(astruct,potype_class_constructor,pd)
               else
-                pd.returndef:=voidtype;
+                recover:=not parse_proc_head(astruct,potype_constructor,pd);
+              if not recover then
+                parse_proc_dec_finish(pd,isclassmethod);
             end;
 
           _DESTRUCTOR :
             begin
               consume(_DESTRUCTOR);
               if isclassmethod then
-                parse_proc_head(astruct,potype_class_destructor,pd)
+                recover:=not parse_proc_head(astruct,potype_class_destructor,pd)
               else
-                parse_proc_head(astruct,potype_destructor,pd);
-              if assigned(pd) then
-                pd.returndef:=voidtype;
+                recover:=not parse_proc_head(astruct,potype_destructor,pd);
+              if not recover then
+                parse_proc_dec_finish(pd,isclassmethod);
             end;
         else
           if (token=_OPERATOR) or
@@ -1294,75 +1416,19 @@ implementation
               parse_proc_head(astruct,potype_operator,pd);
               block_type:=old_block_type;
               if assigned(pd) then
-                begin
-                  { operators always need to be searched in all units (that
-                    contain operators) }
-                  include(pd.procoptions,po_overload);
-                  pd.procsym.owner.includeoption(sto_has_operator);
-                  if pd.parast.symtablelevel>normal_function_level then
-                    Message(parser_e_no_local_operator);
-                  if isclassmethod then
-                    include(pd.procoptions,po_classmethod);
-                  if token<>_ID then
-                    begin
-                       if not(m_result in current_settings.modeswitches) then
-                         consume(_ID);
-                    end
-                  else
-                    begin
-                      pd.resultname:=stringdup(orgpattern);
-                      consume(_ID);
-                    end;
-                  if not try_to_consume(_COLON) then
-                    begin
-                      consume(_COLON);
-                      pd.returndef:=generrordef;
-                      consume_all_until(_SEMICOLON);
-                    end
-                  else
-                   begin
-                     read_returndef(pd);
-                     { check that class operators have either return type of structure or }
-                     { at least one argument of that type                                 }
-                     if (po_classmethod in pd.procoptions) and
-                        (pd.returndef <> pd.struct) then
-                       begin
-                         found:=false;
-                         for i := 0 to pd.parast.SymList.Count - 1 do
-                           if tparavarsym(pd.parast.SymList[i]).vardef=pd.struct then
-                             begin
-                               found:=true;
-                               break;
-                             end;
-                         if not found then
-                           if assigned(pd.struct) then
-                             Message1(parser_e_at_least_one_argument_must_be_of_type,pd.struct.RttiName)
-                           else
-                             MessagePos(pd.fileinfo,type_e_type_id_expected);
-                       end;
-                     if (optoken in [_ASSIGNMENT,_OP_EXPLICIT]) and
-                        equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) and
-                        (pd.returndef.typ<>undefineddef) and (tparavarsym(pd.parast.SymList[0]).vardef.typ<>undefineddef) then
-                       message(parser_e_no_such_assignment)
-                     else if not isoperatoracceptable(pd,optoken) then
-                       Message(parser_e_overload_impossible);
-                   end;
-                end
+                parse_proc_dec_finish(pd,isclassmethod)
               else
                 begin
                   { recover }
                   try_to_consume(_ID);
                   consume(_COLON);
                   consume_all_until(_SEMICOLON);
+                  recover:=true;
                 end;
             end;
         end;
-        { file types can't be function results }
-        if assigned(pd) and
-           (pd.returndef.typ=filedef) then
-          message(parser_e_illegal_function_result);
-        { support procedure proc stdcall export; }
-        if not(check_proc_directive(false)) then
+
+        if recover and not(check_proc_directive(false)) then
           begin
             if (token=_COLON) and not(Assigned(pd) and is_void(pd.returndef)) then
               begin
@@ -1371,14 +1437,8 @@ implementation
               end;
             consume(_SEMICOLON);
           end;
-        result:=pd;
 
-        if locationstr<>'' then
-         begin
-           if not(paramanager.parsefuncretloc(pd,upper(locationstr))) then
-             { I guess this needs a new message... (KB) }
-             message(parser_e_illegal_explicit_paraloc);
-         end;
+        result:=pd;
       end;