paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 21:28:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

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.

Browse Source 
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 -
This commit is contained in:
svenbarth 2013-01-10 16:23:00 +00:00
parent c26ef20f30
commit b5827ce363
9 changed files with 223 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.gitattributes vendored
View File

@ -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

152
compiler/pexpr.pas
View File

@ -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 :

23
compiler/scanner.pas
View File

@ -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

9
tests/tbf/tb0226.pp Normal file
View File

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

9
tests/tbf/tb0227.pp Normal file
View File

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

9
tests/tbf/tb0228.pp Normal file
View File

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

9
tests/tbf/tb0229.pp Normal file
View File

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

9
tests/tbf/tb0230.pp Normal file
View File

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

29
tests/tbs/tb0591.pp Normal file
View File

@ -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.