Browse Source

--- Merging r13550 into '.':
U compiler/cutils.pas
--- Merging r13555 into '.':
U compiler/ptype.pas
--- Merging r13558 into '.':
A tests/tbs/tb0564.pp
U compiler/ncgutil.pas
--- Merging r13559 into '.':
U compiler/optvirt.pas

git-svn-id: branches/fixes_2_4@13568 -

Jonas Maebe 16 years ago
parent
commit
ea2fc88f80
6 changed files with 38 additions and 6 deletions
  1. 1 0
      .gitattributes
  2. 1 1
      compiler/cutils.pas
  3. 8 3
      compiler/ncgutil.pas
  4. 3 1
      compiler/optvirt.pas
  5. 1 1
      compiler/ptype.pas
  6. 24 0
      tests/tbs/tb0564.pp

+ 1 - 0
.gitattributes

@@ -7574,6 +7574,7 @@ tests/tbs/tb0559.pp svneol=native#text/plain
 tests/tbs/tb0560.pp svneol=native#text/plain
 tests/tbs/tb0560.pp svneol=native#text/plain
 tests/tbs/tb0561a.pp svneol=native#text/plain
 tests/tbs/tb0561a.pp svneol=native#text/plain
 tests/tbs/tb0561b.pp svneol=native#text/plain
 tests/tbs/tb0561b.pp svneol=native#text/plain
+tests/tbs/tb0564.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain

+ 1 - 1
compiler/cutils.pas

@@ -123,7 +123,7 @@ interface
     { the data in p is modified and p is returned     }
     { the data in p is modified and p is returned     }
     function pchar2pshortstring(p : pchar) : pshortstring;
     function pchar2pshortstring(p : pchar) : pshortstring;
 
 
-    { ambivalent to pchar2pshortstring }
+    { inverse of pchar2pshortstring }
     function pshortstring2pchar(p : pshortstring) : pchar;
     function pshortstring2pchar(p : pshortstring) : pchar;
 
 
     { Ansistring (pchar+length) support }
     { Ansistring (pchar+length) support }

+ 8 - 3
compiler/ncgutil.pas

@@ -1029,7 +1029,7 @@ implementation
                        tlocalvarsym(p).getsize)
                        tlocalvarsym(p).getsize)
                    else
                    else
                      { may be an open string, even if is_open_string() returns }
                      { may be an open string, even if is_open_string() returns }
-                     { false for some helpers in the system unit               }
+                     { false (for some helpers in the system unit)             }
                      { an open string has at least size 2                      }
                      { an open string has at least size 2                      }
                      trash_reference(list,tabstractnormalvarsym(p).initialloc.reference,
                      trash_reference(list,tabstractnormalvarsym(p).initialloc.reference,
                        2);
                        2);
@@ -1235,7 +1235,12 @@ implementation
                         { needs separate implementation to trash open arrays }
                         { needs separate implementation to trash open arrays }
                         { since their size is only known at run time         }
                         { since their size is only known at run time         }
                         not is_special_array(tparavarsym(p).vardef) then
                         not is_special_array(tparavarsym(p).vardef) then
-                       trash_reference(list,href,tparavarsym(p).vardef.size);
+                        { may be an open string, even if is_open_string() returns }
+                        { false (for some helpers in the system unit)             }
+                       if not is_shortstring(tparavarsym(p).vardef) then
+                         trash_reference(list,href,tparavarsym(p).vardef.size)
+                       else
+                         trash_reference(list,href,2);
                      if needs_inittable then
                      if needs_inittable then
                        cg.g_initialize(list,tparavarsym(p).vardef,href);
                        cg.g_initialize(list,tparavarsym(p).vardef,href);
                    end;
                    end;
@@ -1253,7 +1258,7 @@ implementation
                      reference_reset_base(href,tmpreg,0,
                      reference_reset_base(href,tmpreg,0,
                        used_align(tparavarsym(p).vardef.alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax));
                        used_align(tparavarsym(p).vardef.alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax));
                      { may be an open string, even if is_open_string() returns }
                      { may be an open string, even if is_open_string() returns }
-                     { false for some helpers in the system unit               }
+                     { false (for some helpers in the system unit)             }
                      if not is_shortstring(tparavarsym(p).vardef) then
                      if not is_shortstring(tparavarsym(p).vardef) then
                        trash_reference(list,href,tparavarsym(p).vardef.size)
                        trash_reference(list,href,tparavarsym(p).vardef.size)
                      else
                      else

+ 3 - 1
compiler/optvirt.pas

@@ -1012,8 +1012,10 @@ unit optvirt;
             { cut off the trailing & }
             { cut off the trailing & }
             setlength(classid,length(classid)-1);
             setlength(classid,length(classid)-1);
             classdevirtinfo:=unitdevirtinfo.addclass(classid,instantiated);
             classdevirtinfo:=unitdevirtinfo.addclass(classid,instantiated);
+            { last class could be an instantiated class without any
+               optimisable methods. }
             if not reader.sectiongetnextline(vmttype) then
             if not reader.sectiongetnextline(vmttype) then
-              internalerror(2008100506);
+              exit;
             { any optimisable virtual methods? }
             { any optimisable virtual methods? }
             if (vmttype<>'') then
             if (vmttype<>'') then
               begin
               begin

+ 1 - 1
compiler/ptype.pas

@@ -114,7 +114,7 @@ implementation
                         { we need a class type for classrefdef }
                         { we need a class type for classrefdef }
                         if (def.typ=classrefdef) and
                         if (def.typ=classrefdef) and
                            not(is_class(ttypesym(srsym).typedef)) then
                            not(is_class(ttypesym(srsym).typedef)) then
-                          MessagePos1(tsym(srsym).fileinfo,type_e_class_type_expected,ttypesym(srsym).typedef.typename);
+                          MessagePos1(def.typesym.fileinfo,type_e_class_type_expected,ttypesym(srsym).typedef.typename);
                       end
                       end
                      else
                      else
                       begin
                       begin

+ 24 - 0
tests/tbs/tb0564.pp

@@ -0,0 +1,24 @@
+{ %opt=-gttt }
+{$mode objfpc}
+
+
+procedure get(out s: string);
+begin
+end;
+
+procedure test;
+var
+  s: string[1];
+  a,b: byte;
+begin
+  a:=1;
+  b:=2;
+  get(s);
+  if (a<>1) or
+     (b<>2) then
+    halt(1);
+end;
+
+begin
+  test;
+end.