Bladeren bron

--- Merging r44096 into '.':
U compiler/nbas.pas
--- Recording mergeinfo for merge of r44096 into '.':
U .
--- Merging r46274 into '.':
G compiler/nbas.pas
--- Recording mergeinfo for merge of r46274 into '.':
G .
--- Merging r48127 into '.':
A tests/webtbs/tw38337.pp
--- Recording mergeinfo for merge of r48127 into '.':
G .

git-svn-id: branches/fixes_3_2@48128 -

Jonas Maebe 4 jaren geleden
bovenliggende
commit
8ed055e4bf
3 gewijzigde bestanden met toevoegingen van 35 en 1 verwijderingen
  1. 1 0
      .gitattributes
  2. 14 1
      compiler/nbas.pas
  3. 20 0
      tests/webtbs/tw38337.pp

+ 1 - 0
.gitattributes

@@ -17826,6 +17826,7 @@ tests/webtbs/tw38151.pp svneol=native#text/pascal
 tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3829.pp svneol=native#text/plain
 tests/webtbs/tw3829.pp svneol=native#text/plain
 tests/webtbs/tw3833.pp svneol=native#text/plain
 tests/webtbs/tw3833.pp svneol=native#text/plain
+tests/webtbs/tw38337.pp svneol=native#text/plain
 tests/webtbs/tw3840.pp svneol=native#text/plain
 tests/webtbs/tw3840.pp svneol=native#text/plain
 tests/webtbs/tw3841.pp svneol=native#text/plain
 tests/webtbs/tw3841.pp svneol=native#text/plain
 tests/webtbs/tw3863.pp svneol=native#text/plain
 tests/webtbs/tw3863.pp svneol=native#text/plain

+ 14 - 1
compiler/nbas.pas

@@ -176,7 +176,7 @@ interface
        ttempinfoflags = set of ttempinfoflag;
        ttempinfoflags = set of ttempinfoflag;
 
 
      const
      const
-       tempinfostoreflags = [ti_may_be_in_reg,ti_addr_taken,ti_reference,ti_readonly,ti_no_final_regsync];
+       tempinfostoreflags = [ti_may_be_in_reg,ti_addr_taken,ti_reference,ti_readonly,ti_no_final_regsync,ti_nofini,ti_const];
 
 
      type
      type
        { to allow access to the location by temp references even after the temp has }
        { to allow access to the location by temp references even after the temp has }
@@ -1101,10 +1101,23 @@ implementation
 
 
 
 
     procedure ttempcreatenode.printnodedata(var t:text);
     procedure ttempcreatenode.printnodedata(var t:text);
+      var
+        f: ttempinfoflag;
+        first: Boolean;
       begin
       begin
         inherited printnodedata(t);
         inherited printnodedata(t);
         writeln(t,printnodeindention,'size = ',size,', temptypedef = ',tempinfo^.typedef.typesymbolprettyname,' = "',
         writeln(t,printnodeindention,'size = ',size,', temptypedef = ',tempinfo^.typedef.typesymbolprettyname,' = "',
           tempinfo^.typedef.GetTypeName,'", tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
           tempinfo^.typedef.GetTypeName,'", tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
+        write(t,printnodeindention,'[');
+        first:=true;
+        for f in tempflags do
+          begin
+            if not(first) then
+              write(t,',');
+            write(t,f);
+            first:=false;
+          end;
+        writeln(t,']');
         writeln(t,printnodeindention,'tempinit =');
         writeln(t,printnodeindention,'tempinit =');
         printnode(t,tempinfo^.tempinitcode);
         printnode(t,tempinfo^.tempinitcode);
       end;
       end;

+ 20 - 0
tests/webtbs/tw38337.pp

@@ -0,0 +1,20 @@
+program fs;
+
+{$mode objfpc}{$H+}
+
+function UTF8Length(const s: string): PtrInt; inline;
+begin
+  Result:=9;
+end;
+
+
+var
+  v1: string;
+  s: shortstring;
+  i: Integer;
+begin
+  v1 := '123456789';
+  s := v1;
+  for i := 1 to UTF8Length(s)-8 do begin
+  end;
+end.