Move the handling of "misstyled" floating point constants like "2." or "2.e10" from the scanner to the parser. This way type helpers calls for integer constants can be parsed correctly in the future.

Note: the error messages for incorrect "misstyled" floating point numbers (e.g. "2e10foo") have changed because of this.

scanner.pas, tscannerfile.readtoken:
  instead of tokenizing "2.", "2.e10", "2.e+10" and "2.e-10" as "_REALNUMBER" tokenize them as "_INTCONST _POINT", "_INTCONST _POINT _ID", "_INTCONST _POINT _ID _PLUS _INTCONST" "_INTCONST _POINT _ID _PLUS _INTCONST"; tokenizing of normal floating constants is not changed

pexpr.pas:
  factor: 
    * extract the code for creating a new constant floating point from "factor" into a new function "real_const_node_from_pattern"
    + allow the parsing of postfixoperators for integer constants if a "." is encountered
  + postfixoperators: check for a "misstyled" floating point number if an ordinal const (not an enum and not a boolean) is encountered (the code is already partially prepared for type helper support)
  
+ Added tests

git-svn-id: trunk@23356 -

.gitattributes

@@ -9183,6 +9183,11 @@ tests/tbf/tb0222.pp svneol=native#text/plain
 tests/tbf/tb0223.pp svneol=native#text/pascal
 tests/tbf/tb0224.pp svneol=native#text/pascal
 tests/tbf/tb0225.pp svneol=native#text/pascal
+tests/tbf/tb0226.pp svneol=native#text/pascal
+tests/tbf/tb0227.pp svneol=native#text/pascal
+tests/tbf/tb0228.pp svneol=native#text/pascal
+tests/tbf/tb0229.pp svneol=native#text/pascal
+tests/tbf/tb0230.pp svneol=native#text/pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
@@ -9772,6 +9777,7 @@ tests/tbs/tb0587.pp svneol=native#text/plain
 tests/tbs/tb0588.pp svneol=native#text/pascal
 tests/tbs/tb0589.pp svneol=native#text/pascal
 tests/tbs/tb0590.pp svneol=native#text/pascal
+tests/tbs/tb0591.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain

compiler/pexpr.pas

@@ -1467,6 +1467,37 @@ implementation
 ****************************************************************************}
 
 
+    function real_const_node_from_pattern(s:string):tnode;
+      var
+        d : bestreal;
+        code : integer;
+        cur : currency;
+      begin
+        val(s,d,code);
+        if code<>0 then
+         begin
+           Message(parser_e_error_in_real);
+           d:=1.0;
+         end;
+{$ifdef FPC_REAL2REAL_FIXED}
+        if current_settings.fputype=fpu_none then
+          Message(parser_e_unsupported_real);
+        if (current_settings.minfpconstprec=s32real) and
+           (d = single(d)) then
+          result:=crealconstnode.create(d,s32floattype)
+        else if (current_settings.minfpconstprec=s64real) and
+                (d = double(d)) then
+          result:=crealconstnode.create(d,s64floattype)
+        else
+{$endif FPC_REAL2REAL_FIXED}
+          result:=crealconstnode.create(d,pbestrealtype^);
+{$ifdef FPC_HAS_STR_CURRENCY}
+        val(pattern,cur,code);
+        if code=0 then
+          trealconstnode(result).value_currency:=cur;
+{$endif FPC_HAS_STR_CURRENCY}
+      end;
+
 {---------------------------------------------
                PostFixOperators
 ---------------------------------------------}
@@ -1657,10 +1688,15 @@ implementation
      { shouldn't be used that often, so the extra overhead is ok to save
        stack space }
      dispatchstring : ansistring;
+     haderror,
      nodechanged    : boolean;
      calltype: tdispcalltype;
+     valstr,expstr : string;
+     intval : qword;
+     code : integer;
     label
-     skipreckklammercheck;
+     skipreckklammercheck,
+     skippointdefcheck;
     begin
      result:=false;
      again:=true;
@@ -1844,6 +1880,88 @@ implementation
                  try to call it in case it returns a record/object/... }
                maybe_call_procvar(p1,false);
 
+               if (p1.nodetype=ordconstn) and
+                   not is_boolean(p1.resultdef) and
+                   not is_enum(p1.resultdef) then
+                 begin
+                   { only an "e" or "E" can follow an intconst with a ".", the
+                     other case (another intconst) is handled by the scanner }
+                   if (token=_ID) and (pattern[1]='E') then
+                     begin
+                       haderror:=false;
+                       if length(pattern)>1 then
+                         begin
+                           expstr:=copy(pattern,2,length(pattern)-1);
+                           val(expstr,intval,code);
+                           if code<>0 then
+                             haderror:=true;
+                         end
+                       else
+                         expstr:='';
+                       consume(token);
+                       if tordconstnode(p1).value.signed then
+                         str(tordconstnode(p1).value.svalue,valstr)
+                       else
+                         str(tordconstnode(p1).value.uvalue,valstr);
+                       valstr:=valstr+'.0E';
+                       if expstr='' then
+                         case token of
+                           _MINUS:
+                             begin
+                               consume(token);
+                               if token=_INTCONST then
+                                 begin
+                                   valstr:=valstr+'-'+pattern;
+                                   consume(token);
+                                 end
+                               else
+                                 haderror:=true;
+                             end;
+                           _PLUS:
+                             begin
+                               consume(token);
+                               if token=_INTCONST then
+                                 begin
+                                   valstr:=valstr+pattern;
+                                   consume(token);
+                                 end
+                               else
+                                 haderror:=true;
+                             end;
+                           _INTCONST:
+                             begin
+                               valstr:=valstr+pattern;
+                               consume(_INTCONST);
+                             end;
+                           else
+                             haderror:=true;
+                         end
+                       else
+                         valstr:=valstr+expstr;
+                       if haderror then
+                         begin
+                           Message(parser_e_error_in_real);
+                           p2:=cerrornode.create;
+                         end
+                       else
+                         p2:=real_const_node_from_pattern(valstr);
+                       p1.free;
+                       p1:=p2;
+                       again:=false;
+                       goto skippointdefcheck;
+                     end
+                   else
+                     begin
+                       { just convert the ordconst to a realconst }
+                       p2:=crealconstnode.create(tordconstnode(p1).value,pbestrealtype^);
+                       p1.free;
+                       p1:=p2;
+                       again:=false;
+                       goto skippointdefcheck;
+                     end;
+                 end;
+
+               { this is skipped if label skippointdefcheck is used }
                case p1.resultdef.typ of
                  recorddef:
                    begin
@@ -2051,6 +2169,8 @@ implementation
                       consume(_ID);
                     end;
                end;
+               { processing an ordconstnode avoids the resultdef check }
+               skippointdefcheck:
              end;
 
           else
@@ -2565,7 +2685,6 @@ implementation
          pd         : tprocdef;
          hclassdef  : tobjectdef;
          d          : bestreal;
-         cur        : currency;
          hs,hsorg   : string;
          hdef       : tdef;
          filepos    : tfileposinfo;
@@ -2817,34 +2936,17 @@ implementation
                  else
                    { the necessary range checking has already been done by val }
                    tordconstnode(p1).rangecheck:=false;
+                 if token=_POINT then
+                   begin
+                     again:=true;
+                     postfixoperators(p1,again,getaddr);
+                   end;
                end;
 
              _REALNUMBER :
                begin
-                 val(pattern,d,code);
-                 if code<>0 then
-                  begin
-                    Message(parser_e_error_in_real);
-                    d:=1.0;
-                  end;
+                 p1:=real_const_node_from_pattern(pattern);
                  consume(_REALNUMBER);
-{$ifdef FPC_REAL2REAL_FIXED}
-                 if current_settings.fputype=fpu_none then
-                   Message(parser_e_unsupported_real);
-                 if (current_settings.minfpconstprec=s32real) and
-                    (d = single(d)) then
-                   p1:=crealconstnode.create(d,s32floattype)
-                 else if (current_settings.minfpconstprec=s64real) and
-                         (d = double(d)) then
-                   p1:=crealconstnode.create(d,s64floattype)
-                 else
-{$endif FPC_REAL2REAL_FIXED}
-                   p1:=crealconstnode.create(d,pbestrealtype^);
-{$ifdef FPC_HAS_STR_CURRENCY}
-                 val(pattern,cur,code);
-                 if code=0 then
-                   trealconstnode(p1).value_currency:=cur;
-{$endif FPC_HAS_STR_CURRENCY}
                end;
 
              _STRING :

compiler/scanner.pas

@@ -4075,14 +4075,23 @@ In case not, the value returned can be arbitrary.
                              nexttoken:=_RECKKLAMMER;
                              goto exit_label;
                            end;
+                         '0'..'9' :
+                           begin
+                             { insert the number after the . }
+                             pattern:=pattern+'.';
+                             while c in ['0'..'9'] do
+                              begin
+                                pattern:=pattern+c;
+                                readchar;
+                              end;
+                           end;
+                         else
+                           begin
+                             token:=_INTCONST;
+                             nexttoken:=_POINT;
+                             goto exit_label;
+                           end;
                        end;
-                       { insert the number after the . }
-                       pattern:=pattern+'.';
-                       while c in ['0'..'9'] do
-                        begin
-                          pattern:=pattern+c;
-                          readchar;
-                        end;
                       end;
                   { E can also follow after a point is scanned }
                     if c in ['e','E'] then

tests/tbf/tb0226.pp

@@ -0,0 +1,9 @@
+{ %FAIL }
+
+program tb0226;
+
+var
+  f: Single;
+begin
+  f := 2.efoo;
+end.

tests/tbf/tb0227.pp

@@ -0,0 +1,9 @@
+{ %FAIL }
+
+program tb0227;
+
+var
+  f: Single;
+begin
+  f := 2.e10foo;
+end.

tests/tbf/tb0228.pp

@@ -0,0 +1,9 @@
+{ %FAIL }
+
+program tb0228;
+
+var
+  f: Single;
+begin
+  f := 2.e;
+end.

tests/tbf/tb0229.pp

@@ -0,0 +1,9 @@
+{ %FAIL }
+
+program tb0229;
+
+var
+  f: Single;
+begin
+  f := 2.e+10foo;
+end.

tests/tbf/tb0230.pp

@@ -0,0 +1,9 @@
+{ %FAIL }
+
+program tb0230;
+
+var
+  f: Single;
+begin
+  f := 2.e-10foo;
+end.

tests/tbs/tb0591.pp

@@ -0,0 +1,29 @@
+program tb0591;
+
+uses
+  Math;
+
+procedure TestValue(aActual, aExpected: Double);
+begin
+  if not SameValue(aActual, aExpected) then
+    Halt(1);
+end;
+
+const
+  f1 = 2.;
+  f2 = 2.e10;
+  f3 = 2.e-10;
+  f4 = 2.e+10;
+  f5 = 2.8e10; // ensure that scanning of normal floating points is not broken
+
+begin
+  TestValue(2., 2.0);
+  TestValue(2.e10, 2.0e10);
+  TestValue(2.e-10, 2.0e-10);
+  TestValue(2.e+10, 2.0e+10);
+
+  TestValue(f1, 2.0);
+  TestValue(f2, 2.0e10);
+  TestValue(f3, 2.0e-10);
+  TestValue(f4, 2.0e+10);
+end.