* fixed extended syntax checking {$x-} by moving it from the typecheck pass

to the parser, so that it only looks at what the programmer wrote rather
    than at all statements that the compiler may generate internally
    (mantis #11619)
  + several tests for {$x-} mode
  * modified tenumerators1 so it compiles without extended syntax enabled
    (to check for..in with {$x-})

git-svn-id: trunk@15075 -

.gitattributes

@@ -9117,6 +9117,10 @@ tests/test/tmsg2.pp svneol=native#text/plain
 tests/test/tmsg3.pp svneol=native#text/plain
 tests/test/tmsg4.pp svneol=native#text/plain
 tests/test/tmt1.pp svneol=native#text/plain
+tests/test/tnoext1.pp svneol=native#text/plain
+tests/test/tnoext2.pp svneol=native#text/plain
+tests/test/tnoext3.pp svneol=native#text/plain
+tests/test/tnoext4.pp svneol=native#text/plain
 tests/test/tobjc1.pp svneol=native#text/plain
 tests/test/tobjc10.pp svneol=native#text/plain
 tests/test/tobjc11.pp svneol=native#text/plain
@@ -10086,6 +10090,7 @@ tests/webtbs/tw11568.pp svneol=native#text/plain
 tests/webtbs/tw1157.pp svneol=native#text/plain
 tests/webtbs/tw1157b.pp svneol=native#text/plain
 tests/webtbs/tw11619.pp svneol=native#text/plain
+tests/webtbs/tw11619a.pp svneol=native#text/plain
 tests/webtbs/tw11638.pp svneol=native#text/plain
 tests/webtbs/tw11711.pp svneol=native#text/plain
 tests/webtbs/tw11762.pp svneol=native#text/plain

compiler/nbas.pas

@@ -396,14 +396,6 @@ implementation
 
          { left is the statement itself calln assignn or a complex one }
          typecheckpass(left);
-         if (not (cs_extsyntax in current_settings.moduleswitches)) and
-            assigned(left.resultdef) and
-            not((left.nodetype=calln) and
-                { don't complain when the value is used. And also not for constructors }
-                ((cnf_return_value_used in tcallnode(left).callnodeflags) or
-                 (tcallnode(left).procdefinition.proctypeoption=potype_constructor))) and
-            not(is_void(left.resultdef)) then
-           CGMessage(parser_e_illegal_expression);
          if codegenerror then
            exit;
 
@@ -502,15 +494,6 @@ implementation
                 begin
                    codegenerror:=false;
                    typecheckpass(hp.left);
-                   if not(codegenerror) and
-                      not(cs_extsyntax in current_settings.moduleswitches) and
-                      (hp.left.nodetype=calln) and
-                      not(is_void(hp.left.resultdef)) and
-                      not(cnf_return_value_used in tcallnode(hp.left).callnodeflags) and
-                      not((tcallnode(hp.left).procdefinition.proctypeoption=potype_constructor) and
-                          assigned(tprocdef(tcallnode(hp.left).procdefinition)._class) and
-                          is_object(tprocdef(tcallnode(hp.left).procdefinition)._class)) then
-                     CGMessagePos(hp.left.fileinfo,parser_e_illegal_expression);
                    { the resultdef of the block is the last type that is
                      returned. Normally this is a voidtype. But when the
                      compiler inserts a block of multiple statements then the

compiler/pstatmnt.pas

@@ -1171,13 +1171,24 @@ implementation
 
              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
-                - dispose on FPU stack }
+                - dispose on FPU stack
+                - extended syntax checking }
              if (p.nodetype=calln) then
-               exclude(tcallnode(p).callnodeflags,cnf_return_value_used);
+               begin
+                 exclude(tcallnode(p).callnodeflags,cnf_return_value_used);
 
+                 { in {$x-} state, the function result must not be ignored }
+                 if not(cs_extsyntax in current_settings.moduleswitches) and
+                    not(is_void(p.resultdef)) and
+                    not((tcallnode(p).procdefinition.proctypeoption=potype_constructor) and
+                        assigned(tprocdef(tcallnode(p).procdefinition)._class) and
+                        is_object(tprocdef(tcallnode(p).procdefinition)._class)) then
+                   Message(parser_e_illegal_expression);
+               end;
              code:=p;
            end;
          end;

tests/test/tenumerators1.pp

@@ -4,6 +4,7 @@ program tenumerators1;
 {$mode objfpc}{$H+}
 {$endif}
 {$apptype console}
+{$x-}
 uses
   Classes;
 
@@ -18,12 +19,13 @@ var
   Item: Pointer;
   List: TFPList;
   Enumerator: TFPListEnumerator;
+  i: integer;
 begin
   // check TFPList enumerator
   List := TFPList.Create;
-  List.Add(Pointer(1));
-  List.Add(Pointer(2));
-  List.Add(Pointer(3));
+  i:=List.Add(Pointer(1));
+  i:=List.Add(Pointer(2));
+  i:=List.Add(Pointer(3));
 
   Enumerator := List.GetEnumerator;
   while Enumerator.MoveNext do
@@ -41,12 +43,13 @@ var
   Item: Pointer;
   List: TList;
   Enumerator: TListEnumerator;
+  i: integer;
 begin
   // check TList enumerator
   List := TList.Create;
-  List.Add(Pointer(1));
-  List.Add(Pointer(2));
-  List.Add(Pointer(3));
+  i:=List.Add(Pointer(1));
+  i:=List.Add(Pointer(2));
+  i:=List.Add(Pointer(3));
 
   Enumerator := List.GetEnumerator;
   while Enumerator.MoveNext do
@@ -66,9 +69,9 @@ var
 begin
   // check TCollection enumerator
   Collection := TCollection.Create(TCollectionItem);
-  Collection.Add;
-  Collection.Add;
-  Collection.Add;
+  item:=Collection.Add;
+  item:=Collection.Add;
+  item:=Collection.Add;
 
   Enumerator := Collection.GetEnumerator;
   while Enumerator.MoveNext do
@@ -85,12 +88,13 @@ var
   Item: String;
   Strings: TStrings;
   Enumerator: TStringsEnumerator;
+  i: integer;
 begin
   // check TStrings enumerator
   Strings := TStringList.Create;
-  Strings.Add('1');
-  Strings.Add('2');
-  Strings.Add('3');
+  i:=Strings.Add('1');
+  i:=Strings.Add('2');
+  i:=Strings.Add('3');
 
   Enumerator := Strings.GetEnumerator;
   while Enumerator.MoveNext do
@@ -110,9 +114,9 @@ var
 begin
   // check TComponent enumerator
   Component := TComponent.Create(nil);
-  TComponent.Create(Component);
-  TComponent.Create(Component);
-  TComponent.Create(Component);
+  item:=TComponent.Create(Component);
+  item:=TComponent.Create(Component);
+  item:=TComponent.Create(Component);
 
   Enumerator := Component.GetEnumerator;
   while Enumerator.MoveNext do
@@ -129,15 +133,16 @@ var
   Item: IUnknown;
   List: TInterfaceList;
   Enumerator: TInterfaceListEnumerator;
+  i: integer;
 begin
   // check TInterfaceList enumerator
   List := TInterfaceList.Create;
   Item := TInterfacedObject.Create;
-  List.Add(Item);
+  i:=List.Add(Item);
   Item := TInterfacedObject.Create;
-  List.Add(Item);
+  i:=List.Add(Item);
   Item := TInterfacedObject.Create;
-  List.Add(Item);
+  i:=List.Add(Item);
 
   Enumerator := List.GetEnumerator;
   while Enumerator.MoveNext do

tests/test/tnoext1.pp

@@ -0,0 +1,10 @@
+{ %fail }
+{$x-}
+
+function f: longint;
+begin
+end;
+
+begin
+  f;
+end.

tests/test/tnoext2.pp

@@ -0,0 +1,7 @@
+{ %fail }
+{$mode objfpc}
+{$x-}
+
+begin
+  tobject.create;
+end.

tests/test/tnoext3.pp

@@ -0,0 +1,100 @@
+{ %norun }
+{$x-}
+uses
+  variants;
+
+type
+  tobj = object
+    constructor init;
+    destructor done;
+  end;
+   
+ constructor tobj.init;
+   begin
+   end;
+
+ destructor tobj.done;
+   begin
+   end;
+
+procedure testcomplexassignments;
+var
+  s1,s2: shortstring;
+  a1,a2: ansistring;
+  w1,w2: widestring;
+  u1,u2: unicodestring;
+  v1,v2: variant;
+  arr: array[1..4] of char;
+  c: char;
+  wc: widechar;
+  p: pchar;
+  pw: pwidechar;
+  darr: array of char;
+begin
+  s1:=s2;
+  a1:=a2;
+  w1:=w2;
+  u1:=u2;
+  v1:=v2;
+  s1:=arr;
+  a1:=arr;
+  w1:=arr;
+  u1:=arr;
+  arr:=s1;
+  arr:=a1;
+  arr:=w1;
+  arr:=u1;
+  s1:=c;
+  a1:=c;
+  w1:=c;
+  u1:=c;
+  s1:=wc;
+  a1:=wc;
+  w1:=wc;
+  u1:=wc;
+  s1:=p;
+  a1:=p;
+  w1:=p;
+  u1:=p;
+  s1:=pw;
+  a1:=pw;
+  w1:=pw;
+  u1:=pw;
+  v1:=darr;
+end;
+
+
+procedure testval;
+var
+  ss: shortstring;
+  b: byte;
+  w: word;
+  c: cardinal;
+  q: qword;
+  si: shortint;
+  i: smallint;
+  l: longint;
+  ii: int64;
+begin
+  val(ss,b,w);
+  val(ss,c,b);
+{$ifdef cpu64}
+  val(ss,c,q);
+{$endif}
+  val(ss,q,si);
+  val(ss,si,i);
+  val(ss,i,l);
+{$ifdef cpu64}
+  val(ss,l,ii);
+{$endif}
+  val(ss,ii,l);
+end;
+
+var
+  o: tobj;
+  po: ^tobj;
+begin
+  o.init;
+  new(po,init);
+  dispose(po,done);
+end.

tests/test/tnoext4.pp

@@ -0,0 +1,21 @@
+{ %norun }
+{$mode objfpc}
+{x-}
+
+type
+ tr = record end;
+
+operator +(const r1,r2: tr) res: tr;
+begin
+end;
+
+operator:=(const r: tr) res: longint;
+begin
+end;
+
+var
+ r1, r2: tr;
+ l:longint;
+begin
+  l:=r1+r2;
+end.

tests/webtbs/tw11619a.pp

@@ -0,0 +1,26 @@
+{ %norun }
+{$mode objfpc}
+{$inline on}
+{$x-}
+
+function Min(a, b: Double): Double;inline;
+begin
+  if a < b then
+    Result := a
+  else
+    Result := b;
+end;
+
+function Max(a, b: Double): Double;inline;
+begin
+  if a > b then
+    Result := a
+  else
+    Result := b;
+end;
+
+var
+  a, b: double;
+begin
+  a:=min(max(a,b),min(a,b));
+end.