* do not typecheck statements before checking whether they are valid,

    because the associated simplifications can turn invalid statements
    into valid statements (based on patch by Aleksa Todorovic, mantis
    #15594)

git-svn-id: trunk@14998 -

.gitattributes

@@ -9637,6 +9637,8 @@ tests/webtbf/tw15288.pp svneol=native#text/plain
 tests/webtbf/tw15303.pp svneol=native#text/plain
 tests/webtbf/tw15391a.pp svneol=native#text/plain
 tests/webtbf/tw15447.pp svneol=native#text/plain
+tests/webtbf/tw15594a.pp svneol=native#text/plain
+tests/webtbf/tw15594b.pp svneol=native#text/plain
 tests/webtbf/tw15727b.pp svneol=native#text/plain
 tests/webtbf/tw1599.pp svneol=native#text/plain
 tests/webtbf/tw1599b.pp svneol=native#text/plain

compiler/pdecvar.pas

@@ -1047,7 +1047,7 @@ implementation
           if vo_is_typed_const in vs.varoptions then
             Message(parser_e_initialized_not_for_external);
           { parse the rest }
-          pt:=expr;
+          pt:=expr(true);
           { check allowed absolute types }
           if (pt.nodetype=stringconstn) or
             (is_constcharnode(pt)) then
@@ -1084,7 +1084,7 @@ implementation
                   try_to_consume(_COLON) then
                 begin
                   pt.free;
-                  pt:=expr;
+                  pt:=expr(true);
                   if is_constintnode(pt) then
                     begin
                       tmpaddr:=abssym.addroffset shl 4+tordconstnode(pt).value.svalue;

compiler/pexpr.pas

@@ -31,7 +31,7 @@ interface
       tokens,globtype,globals,constexp;
 
     { reads a whole expression }
-    function expr : tnode;
+    function expr(dotypecheck : boolean) : tnode;
 
     { reads an expression without assignements and .. }
     function comp_expr(accept_equal : boolean):tnode;
@@ -2840,7 +2840,7 @@ implementation
       end;
 
 
-    function expr : tnode;
+    function expr(dotypecheck : boolean) : tnode;
 
       var
          p1,p2 : tnode;
@@ -2852,7 +2852,8 @@ implementation
          oldafterassignment:=afterassignment;
          p1:=sub_expr(opcompare,true);
          { get the resultdef for this expression }
-         if not assigned(p1.resultdef) then
+         if not assigned(p1.resultdef) and
+            dotypecheck then
           do_typecheckpass(p1);
          filepos:=current_tokenpos;
          if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
@@ -2904,7 +2905,8 @@ implementation
             updatefpos:=false;
          end;
          { get the resultdef for this expression }
-         if not assigned(p1.resultdef) then
+         if not assigned(p1.resultdef) and
+            dotypecheck then
           do_typecheckpass(p1);
          afterassignment:=oldafterassignment;
          if updatefpos then

compiler/pstatmnt.pas

@@ -161,7 +161,7 @@ implementation
          repeat
            { maybe an instruction has more case labels }
            repeat
-             p:=expr;
+             p:=expr(true);
              if is_widechar(casedef) then
                begin
                   if (p.nodetype=rangen) then
@@ -1105,7 +1105,10 @@ implementation
              Message(scan_f_end_of_file);
          else
            begin
-             p:=expr;
+             { don't typecheck yet, because that will also simplify, which may
+               result in not detecting certain kinds of syntax errors --
+               see mantis #15594 }
+             p:=expr(false);
              { save the pattern here for latter usage, the label could be "000",
                even if we read an expression, the pattern is still valid if it's really
                a label (FK)
@@ -1166,6 +1169,8 @@ implementation
                  (tcallnode(p).procdefinition.proctypeoption=potype_operator)) then
                Message(parser_e_illegal_expression);
 
+             if not assigned(p.resultdef) then
+               do_typecheckpass(p);
              { Specify that we don't use the value returned by the call.
                This is used for :
                 - dispose of temp stack space

compiler/ptype.pas

@@ -748,7 +748,7 @@ implementation
                    end
                   else
                    begin
-                     pt:=expr;
+                     pt:=expr(true);
                      if pt.nodetype=typen then
                        setdefdecl(pt.resultdef)
                      else

tests/webtbf/tw15594a.pp

@@ -0,0 +1,44 @@
+{ %fail }
+
+program project1;
+
+{$mode objfpc}{$H+}
+
+type
+  
+  { TBoolObject }
+
+  TBoolObject = class(TObject)
+  private
+    fBool: Boolean;
+    procedure SetBool(const AValue: Boolean);
+  
+  protected
+    function GetBool: Boolean;
+    property Bool: Boolean read GetBool write SetBool default True;
+  end;
+  
+  TSubBoolObject = class(TBoolObject)
+  published
+    property Bool default True;
+  end;
+
+{ TBoolObject }
+
+procedure TBoolObject.SetBool(const AValue: Boolean);
+begin
+  fBool:=AValue;
+end;
+
+function TBoolObject.GetBool: Boolean; 
+begin
+  Result:=fBool;
+end;
+  
+var
+  b: TSubBoolObject;
+begin
+  b:=TSubBoolObject.Create;
+  b.Bool=True; // NO ERROR!!! why?????
+  b.Free;
+end.

tests/webtbf/tw15594b.pp

@@ -0,0 +1,44 @@
+{ %fail }
+
+program project1;
+
+{$mode objfpc}{$H+}
+
+type
+  
+  { TBoolObject }
+
+  TBoolObject = class(TObject)
+  private
+    fBool: Boolean;
+    procedure SetBool(const AValue: Boolean);
+  
+  protected
+    function GetBool: Boolean;
+    property Bool: Boolean read GetBool write SetBool default True;
+  end;
+  
+  TSubBoolObject = class(TBoolObject)
+  published
+    property Bool default True;
+  end;
+
+{ TBoolObject }
+
+procedure TBoolObject.SetBool(const AValue: Boolean);
+begin
+  fBool:=AValue;
+end;
+
+function TBoolObject.GetBool: Boolean; 
+begin
+  Result:=fBool;
+end;
+  
+var
+  b: TSubBoolObject;
+begin
+  b:=TSubBoolObject.Create;
+  b.Bool=False; // error: Illegal expression
+  b.Free;
+end.