* set the location size of load nodes of procsyms without methodpointer/

    framepointer
  * fixed conversion of procedure of object/nested procedure into a procvar
    that only contains the code address

git-svn-id: trunk@23928 -

.gitattributes

@@ -9836,6 +9836,7 @@ tests/tbs/tb0590.pp svneol=native#text/pascal
 tests/tbs/tb0591.pp svneol=native#text/pascal
 tests/tbs/tb0592.pp svneol=native#text/plain
 tests/tbs/tb0593.pp svneol=native#text/pascal
+tests/tbs/tb0594.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tbs0594.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain

compiler/ncgcnv.pas

@@ -492,8 +492,44 @@ interface
         if tabstractprocdef(resultdef).is_addressonly then
           begin
             location_reset(location,LOC_REGISTER,OS_ADDR);
-            location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
-            cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,location.register);
+            { only a code pointer? (when taking the address of classtype.method
+              we also only get a code pointer even though the resultdef is a
+              procedure of object, and hence is_addressonly would return false)
+             }
+	    if left.location.size = OS_ADDR then
+              begin
+                case left.location.loc of
+                  LOC_REFERENCE,LOC_CREFERENCE:
+                    begin
+                      { the procedure symbol is encoded in reference.symbol -> take address }
+                      location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
+                      cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,location.register);
+                    end;
+                  else
+                    internalerror(2013031501)
+                end;
+              end
+            else
+              begin
+                { conversion from a procedure of object/nested procvar to plain procvar }
+                case left.location.loc of
+                  LOC_REFERENCE,LOC_CREFERENCE:
+                    begin
+                      location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
+                      { code field is the first one }
+                      cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference,location.register);
+                    end;
+                  LOC_REGISTER,LOC_CREGISTER:
+                    begin
+                      if target_info.endian=endian_little then
+                        location.register:=left.location.register
+                      else
+                        location.register:=left.location.registerhi;
+                    end;
+                  else
+                    internalerror(2013031502)
+                end;
+              end;
           end
         else
           begin
@@ -503,6 +539,8 @@ interface
               begin
                 { assigning a global function to a nested procvar -> create
                   tmethodpointer record and set the "frame pointer" to nil }
+                if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+                  internalerror(2013031503);
                 location_reset_ref(location,LOC_REFERENCE,int_cgsize(sizeof(pint)*2),sizeof(pint));
                 tg.gethltemp(current_asmdata.CurrAsmList,resultdef,resultdef.size,tt_normal,location.reference);
                 tmpreg:=cg.getaddressregister(current_asmdata.CurrAsmList);

compiler/ncgld.pas

@@ -566,6 +566,8 @@ implementation
                    end
                  else
                    begin
+                      { def_cgsize does not work for procdef }
+                      location.size:=OS_ADDR;
                       pd:=tprocdef(tprocsym(symtableentry).ProcdefList[0]);
                       if not(po_weakexternal in pd.procoptions) then
                         location.reference.symbol:=current_asmdata.RefAsmSymbol(procdef.mangledname)

tests/tbs/tb0594.pp

@@ -0,0 +1,25 @@
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+type
+  tc = class
+    class procedure test;
+  end;
+
+  tp = procedure;
+  tp2 = procedure of object;
+
+class procedure tc.test;
+begin
+end;
+
+var
+  p: tp;
+  p2: tp2;
+begin
+  p:=tp(tc.test);
+  p2:=tc.test;
+  if pointer(@p)<>tmethod(p2).code then
+    halt(1);
+end.