* check function/procedure type when adding a proc definition

git-svn-id: trunk@546 -

.gitattributes

@@ -4423,6 +4423,7 @@ tests/tbf/tb0174a.pp svneol=native#text/plain
 tests/tbf/tb0174b.pp svneol=native#text/plain
 tests/tbf/tb0174c.pp svneol=native#text/plain
 tests/tbf/tb0174d.pp svneol=native#text/plain
+tests/tbf/tb0175.pp svneol=native#text/plain
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain

compiler/arm/cgcpu.pas

@@ -1414,7 +1414,7 @@ unit cgcpu;
         make_global : boolean;
         href : treference;
       begin
-        if procdef.proctypeoption<>potype_none then
+        if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
           Internalerror(200006137);
         if not assigned(procdef._class) or
            (procdef.procoptions*[po_classmethod, po_staticmethod,

compiler/i386/cgcpu.pas

@@ -529,7 +529,7 @@ unit cgcpu;
         make_global : boolean;
         href : treference;
       begin
-        if procdef.proctypeoption<>potype_none then
+        if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
           Internalerror(200006137);
         if not assigned(procdef._class) or
            (procdef.procoptions*[po_classmethod, po_staticmethod,

compiler/pdecsub.pas

@@ -878,7 +878,7 @@ implementation
           _FUNCTION :
             begin
               consume(_FUNCTION);
-              if parse_proc_head(aclass,potype_none,pd) then
+              if parse_proc_head(aclass,potype_function,pd) then
                 begin
                   { pd=nil when it is a interface mapping }
                   if assigned(pd) then
@@ -917,7 +917,7 @@ implementation
           _PROCEDURE :
             begin
               consume(_PROCEDURE);
-              if parse_proc_head(aclass,potype_none,pd) then
+              if parse_proc_head(aclass,potype_procedure,pd) then
                 begin
                   { pd=nil when it is a interface mapping }
                   if assigned(pd) then

compiler/powerpc/cgcpu.pas

@@ -1180,7 +1180,7 @@ const
              { compute start of gpr save area }
              inc(href.offset,4);
           end
-        else 
+        else
           { compute start of gpr save area }
           reference_reset_base(href,NR_R12,-4);
 
@@ -1584,7 +1584,7 @@ const
      const
          macosLinkageAreaSize = 24;
 
-     var 
+     var
          href : treference;
          registerSaveAreaSize : longint;
 
@@ -2034,7 +2034,7 @@ const
       var
         make_global : boolean;
       begin
-        if procdef.proctypeoption<>potype_none then
+        if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
           Internalerror(200006137);
         if not assigned(procdef._class) or
            (procdef.procoptions*[po_classmethod, po_staticmethod,

compiler/sparc/cgcpu.pas

@@ -1263,7 +1263,7 @@ implementation
         make_global : boolean;
         href : treference;
       begin
-        if procdef.proctypeoption<>potype_none then
+        if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
           Internalerror(200006137);
         if not assigned(procdef._class) or
            (procdef.procoptions*[po_classmethod, po_staticmethod,

compiler/symconst.pas

@@ -219,7 +219,9 @@ type
     potype_unitfinalize, { unit finalization }
     potype_constructor,  { Procedure is a constructor }
     potype_destructor,   { Procedure is a destructor }
-    potype_operator      { Procedure defines an operator }
+    potype_operator,     { Procedure defines an operator }
+    potype_procedure,
+    potype_function
   );
   tproctypeoptions=set of tproctypeoption;
 

compiler/utils/ppudump.pp

@@ -798,7 +798,7 @@ type
     pocall_softfloat,
     { Metrowerks Pascal. Special case on Mac OS (X): passes all }
     { constant records by reference.                            }
-    pocall_mwpascal    
+    pocall_mwpascal
   );
   tproccalloptions=set of tproccalloption;
   tproctypeoption=(potype_none,
@@ -807,7 +807,9 @@ type
     potype_unitfinalize, { unit finalization }
     potype_constructor,  { Procedure is a constructor }
     potype_destructor,   { Procedure is a destructor }
-    potype_operator      { Procedure defines an operator }
+    potype_operator,     { Procedure defines an operator }
+    potype_procedure,
+    potype_function
   );
   tproctypeoptions=set of tproctypeoption;
   tprocoption=(po_none,
@@ -877,14 +879,16 @@ const
      'SoftFloat',
      'MWPascal'
    );
-  proctypeopts=6;
+  proctypeopts=8;
   proctypeopt : array[1..proctypeopts] of tproctypeopt=(
      (mask:potype_proginit;    str:'ProgInit'),
      (mask:potype_unitinit;    str:'UnitInit'),
      (mask:potype_unitfinalize;str:'UnitFinalize'),
      (mask:potype_constructor; str:'Constructor'),
      (mask:potype_destructor;  str:'Destructor'),
-     (mask:potype_operator;    str:'Operator')
+     (mask:potype_operator;    str:'Operator'),
+     (mask:potype_function;    str:'Function'),
+     (mask:potype_procedure;   str:'Procedure')
   );
   procopts=26;
   procopt : array[1..procopts] of tprocopt=(
@@ -925,21 +929,18 @@ begin
   readtype;
   writeln(space,'         Fpu used : ',ppufile.getbyte);
   proctypeoption:=tproctypeoption(ppufile.getbyte);
-  if proctypeoption<>potype_none then
+  write(space,'       TypeOption : ');
-   begin
+  first:=true;
-     write(space,'       TypeOption : ');
+  for i:=1 to proctypeopts do
-     first:=true;
+   if (proctypeopt[i].mask=proctypeoption) then
-     for i:=1 to proctypeopts do
+    begin
-      if (proctypeopt[i].mask=proctypeoption) then
+      if first then
-       begin
+        first:=false
-         if first then
+      else
-           first:=false
+        write(', ');
-         else
+      write(proctypeopt[i].str);
-           write(', ');
+    end;
-         write(proctypeopt[i].str);
+  writeln;
-       end;
-     writeln;
-   end;
   proccalloption:=tproccalloption(ppufile.getbyte);
   writeln(space,'       CallOption : ',proccalloptionStr[proccalloption]);
   ppufile.getsmallset(procoptions);
@@ -1498,7 +1499,7 @@ begin
                  { library symbol for AmigaOS/MorphOS }
                  write  (space,'   Library symbol : ');
                  readderef;
-	       end;	 
+	       end;
              if (calloption=pocall_inline) then
               begin
                 write  (space,'       FuncretSym : ');

compiler/x86_64/cgcpu.pas

@@ -90,7 +90,7 @@ unit cgcpu;
         make_global : boolean;
         href : treference;
       begin
-        if procdef.proctypeoption<>potype_none then
+        if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
           Internalerror(200006137);
         if not assigned(procdef._class) or
            (procdef.procoptions*[po_classmethod, po_staticmethod,

tests/tbf/tb0175.pp

@@ -0,0 +1,21 @@
+{$ifdef fpc}
+  {$Mode Delphi}
+{$endif}
+
+unit tb0175;
+
+interface
+
+      function getvar: string;
+
+implementation
+
+   var
+     myvar : string;
+
+   procedure getvar;
+   begin
+      result := myvar;
+   end;
+
+end.