# revisions: 44598,45635,45757,45764,45772

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

.gitattributes

@@ -17626,6 +17626,7 @@ tests/webtbs/tw36698.pp -text svneol=native#text/pascal
 tests/webtbs/tw3676.pp svneol=native#text/plain
 tests/webtbs/tw3681.pp svneol=native#text/plain
 tests/webtbs/tw3683.pp svneol=native#text/plain
+tests/webtbs/tw36863.pp svneol=native#text/pascal
 tests/webtbs/tw3687.pp svneol=native#text/plain
 tests/webtbs/tw3691.pp svneol=native#text/plain
 tests/webtbs/tw36934.pp svneol=native#text/plain
@@ -17636,9 +17637,12 @@ tests/webtbs/tw3700.pp svneol=native#text/plain
 tests/webtbs/tw3708.pp svneol=native#text/plain
 tests/webtbs/tw37095.pp svneol=native#text/plain
 tests/webtbs/tw37095d/uw37095.pp svneol=native#text/plain
+tests/webtbs/tw37154.pp svneol=native#text/pascal
 tests/webtbs/tw3719.pp svneol=native#text/plain
 tests/webtbs/tw3721.pp svneol=native#text/plain
 tests/webtbs/tw37228.pp svneol=native#text/plain
+tests/webtbs/tw37322.pp svneol=native#text/pascal
+tests/webtbs/tw37323.pp svneol=native#text/pascal
 tests/webtbs/tw3742.pp svneol=native#text/plain
 tests/webtbs/tw3751.pp svneol=native#text/plain
 tests/webtbs/tw3758.pp svneol=native#text/plain

compiler/ninl.pas

@@ -437,23 +437,30 @@ implementation
           { can't hardcode the position of the '$', e.g. on darwin an underscore
             is added }
           hashedid.id:=copy(defaultname,2,255);
-          { the default sym is always part of the current procedure/function }
-          srsymtable:=current_procinfo.procdef.localst;
-          srsym:=tsym(srsymtable.findwithhash(hashedid));
-          if not assigned(srsym) then
+          { in case of a previous error, current_procinfo might not be set
+            so avoid a crash in this case }
+          if assigned(current_procinfo) then
             begin
-              { no valid default variable found, so create it }
-              srsym:=clocalvarsym.create(defaultname,vs_const,def,[]);
-              srsymtable.insert(srsym);
-              { mark the staticvarsym as typedconst }
-              include(tabstractvarsym(srsym).varoptions,vo_is_typed_const);
-              include(tabstractvarsym(srsym).varoptions,vo_is_default_var);
-              { The variable has a value assigned }
-              tabstractvarsym(srsym).varstate:=vs_initialised;
-              { the variable can't be placed in a register }
-              tabstractvarsym(srsym).varregable:=vr_none;
-            end;
-          result:=cloadnode.create(srsym,srsymtable);
+              { the default sym is always part of the current procedure/function }
+              srsymtable:=current_procinfo.procdef.localst;
+              srsym:=tsym(srsymtable.findwithhash(hashedid));
+              if not assigned(srsym) then
+                begin
+                  { no valid default variable found, so create it }
+                  srsym:=clocalvarsym.create(defaultname,vs_const,def,[]);
+                  srsymtable.insert(srsym);
+                  { mark the staticvarsym as typedconst }
+                  include(tabstractvarsym(srsym).varoptions,vo_is_typed_const);
+                  include(tabstractvarsym(srsym).varoptions,vo_is_default_var);
+                  { The variable has a value assigned }
+                  tabstractvarsym(srsym).varstate:=vs_initialised;
+                  { the variable can't be placed in a register }
+                  tabstractvarsym(srsym).varregable:=vr_none;
+                end;
+              result:=cloadnode.create(srsym,srsymtable);
+            end
+          else
+            result:=cerrornode.create;
         end;
 
       var

compiler/nutils.pas

@@ -610,13 +610,21 @@ implementation
 
         block:=nil;
         stat:=nil;
+        self_temp:=nil;
         if docheck then
           begin
             { check for nil self-pointer }
             block:=internalstatements(stat);
-            self_temp:=ctempcreatenode.create_value(
-              self_resultdef,self_resultdef.size,tt_persistent,true,
-              self_node);
+            if is_object(self_resultdef) then
+              begin
+                self_temp:=ctempcreatenode.create_value(
+                  cpointerdef.getreusable(self_resultdef),cpointerdef.getreusable(self_resultdef).size,tt_persistent,true,
+                  caddrnode.create(self_node));
+              end
+            else
+              self_temp:=ctempcreatenode.create_value(
+                self_resultdef,self_resultdef.size,tt_persistent,true,
+                self_node);
             addstatement(stat,self_temp);
 
             { in case of an object, self can only be nil if it's a dereferenced
@@ -626,8 +634,6 @@ implementation
                (actualtargetnode(@self_node)^.nodetype=derefn) then
               begin
                 check_self:=ctemprefnode.create(self_temp);
-                if is_object(self_resultdef) then
-                  check_self:=caddrnode.create(check_self);
                 addstatement(stat,cifnode.create(
                   caddnode.create(equaln,
                     ctypeconvnode.create_explicit(
@@ -639,8 +645,10 @@ implementation
                   nil)
                 );
               end;
-            addstatement(stat,ctempdeletenode.create_normal_temp(self_temp));
-            self_node:=ctemprefnode.create(self_temp);
+            if is_object(self_resultdef) then
+              self_node:=cderefnode.create(ctemprefnode.create(self_temp))
+            else
+              self_node:=ctemprefnode.create(self_temp)
           end;
         { in case of a classref, the "instance" is a pointer
           to pointer to a VMT and there is no vmt field }
@@ -690,6 +698,7 @@ implementation
                 )
               );
             addstatement(stat,ctempdeletenode.create_normal_temp(vmt_temp));
+            addstatement(stat,ctempdeletenode.create(self_temp));
             addstatement(stat,ctemprefnode.create(vmt_temp));
             result:=block;
           end

compiler/pdecl.pas

@@ -360,7 +360,14 @@ implementation
                 if token=_ID then
                   labelsym:=clabelsym.create(orgpattern)
                 else
-                  labelsym:=clabelsym.create(pattern);
+                  begin
+                    { strip leading 0's in iso mode }
+                    if (([m_iso,m_extpas]*current_settings.modeswitches)<>[]) then
+                      while pattern[1]='0' do
+                        delete(pattern,1,1);
+                    labelsym:=clabelsym.create(pattern);
+                  end;
+
                 symtablestack.top.insert(labelsym);
                 if m_non_local_goto in current_settings.modeswitches then
                   begin

compiler/symtable.pas

@@ -2553,6 +2553,8 @@ implementation
                 HideSym(hsym);
                 tstaticvarsym(sym).isoindex:=tprogramparasym(hsym).isoindex;
               end
+            else if (m_iso in current_settings.modeswitches) and (hsym.typ=unitsym) then
+              HideSym(hsym)
             else
               DuplicateSym(hashedid,sym,hsym,false);
             result:=true;

rtl/inc/text.inc

@@ -1457,7 +1457,7 @@ begin
     end;
   if TextRec(f).BufPos>=TextRec(f).BufEnd Then
     FileFunc(TextRec(f).InOutFunc)(TextRec(f));
-  CheckRead:=True;
+  CheckRead:=InOutRes=0;
 end;
 
 
@@ -1991,11 +1991,15 @@ var
   hs   : String;
   code : ValSInt;
 Begin
-    ReadInteger(f,hs);
+  l:=0;
+  if not CheckRead(f) then
+    Exit;
 
-    Val(hs,l,code);
-    if Code <> 0 then
-        InOutRes:=106;
+  ReadInteger(f,hs);
+
+  Val(hs,l,code);
+  if Code <> 0 then
+    InOutRes:=106;
 End;
 
 
@@ -2031,10 +2035,14 @@ var
   hs   : String;
   code : ValSInt;
 Begin
-   ReadInteger(f,hs);
-   Val(hs,u,code);
-   If code<>0 Then
-       InOutRes:=106;
+  u:=0;
+  if not CheckRead(f) then
+    Exit;
+
+  ReadInteger(f,hs);
+  Val(hs,u,code);
+  If code<>0 Then
+     InOutRes:=106;
 End;
 
 
@@ -2067,6 +2075,10 @@ var
   hs : string;
   code : Word;
 begin
+  v:=0.0;
+  if not CheckRead(f) then
+    Exit;
+
   ReadReal(f,hs);
   Val(hs,v,code);
   If code<>0 Then
@@ -2127,6 +2139,10 @@ var
   hs : string;
   code : ValSInt;
 begin
+  v:=0.0;
+  if not CheckRead(f) then
+    Exit;
+
   ReadReal(f,hs);
   Val(hs,v,code);
   If code<>0 Then
@@ -2163,10 +2179,14 @@ var
   hs   : String;
   code : longint;
 Begin
-   ReadInteger(f,hs);
-   Val(hs,q,code);
-   If code<>0 Then
-       InOutRes:=106;
+  q:=0;
+  if not CheckRead(f) then
+    Exit;
+
+  ReadInteger(f,hs);
+  Val(hs,q,code);
+  If code<>0 Then
+    InOutRes:=106;
 End;
 
 procedure fpc_Read_Text_Int64(var f : text; out i : int64); iocheck; compilerproc;
@@ -2196,10 +2216,14 @@ var
   hs   : String;
   code : Longint;
 Begin
-    ReadInteger(f,hs);
-    Val(hs,i,code);
-    If code<>0 Then
-       InOutRes:=106;
+  l:=0;
+  if not CheckRead(f) then
+    Exit;
+
+  ReadInteger(f,hs);
+  Val(hs,i,code);
+  If code<>0 Then
+    InOutRes:=106;
 End;
 
 

tests/webtbs/tw36863.pp

@@ -0,0 +1,30 @@
+{ %OPT=-Ct -CR }
+{$M 65536,65536}
+
+type
+  TObj = object
+    v: array [0..$2000] of Byte;
+    procedure Proc(depth: Integer);
+    procedure VProc; virtual;
+  end;
+
+  procedure TObj.VProc;
+  begin
+  end;
+
+  procedure TObj.Proc(depth: Integer);
+  begin
+    {stack is eaten here on the function entry}
+    if (depth < 64) then
+      Proc(depth+1);
+    {do not actually call the method since the obj is not initialized, just for minimal demonstration}
+    if (depth < 0) then
+    VProc;
+  end;
+
+var
+  Obj: TObj;
+begin
+  Obj.Proc(0);
+  writeln('Completed');
+end.

tests/webtbs/tw37154.pp

@@ -0,0 +1,11 @@
+{ %RESULT=6 }
+{$mode ISO}
+program isoModeReadingNumbers(input, output);
+var
+    i: integer;
+begin
+ { we cannot call the executable with <&- >&- while running the test suite,
+   so render the file handle manually illegal }   
+ Textrec(input).handle:=$1234;
+ readLn(i);
+end.

tests/webtbs/tw37322.pp

@@ -0,0 +1,7 @@
+{ %OPT=-Miso }
+program test;
+
+var test: integer;
+
+begin
+end.

tests/webtbs/tw37323.pp

@@ -0,0 +1,9 @@
+{ %OPT=-Miso -Sg }
+program test;
+
+label 0001;
+
+begin
+     goto 1;
+   1:
+end.