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

* fix for Mantis #35866: parse_paras does not check whether the expressions are really constant, so check that manually

Browse Source 
+ added test

git-svn-id: trunk@42469 -
This commit is contained in:
svenbarth 2019-07-20 19:45:59 +00:00
parent 75321c848d
commit 6cde8ab4cb
3 changed files with 78 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -14943,6 +14943,7 @@ tests/webtbf/tw3562.pp svneol=native#text/plain
tests/webtbf/tw35671.pp svneol=native#text/plain
tests/webtbf/tw35753.pp svneol=native#text/plain
tests/webtbf/tw3583.pp svneol=native#text/plain
tests/webtbf/tw35866.pp svneol=native#text/pascal
tests/webtbf/tw3626.pp svneol=native#text/plain
tests/webtbf/tw3631.pp svneol=native#text/plain
tests/webtbf/tw3643.pp svneol=native#text/plain

30
compiler/pdecl.pas
View File

@ -428,11 +428,12 @@ implementation
var
p,paran,pcalln,ptmp : tnode;
pcount : sizeint;
i,pcount : sizeint;
paras : array of tnode;
od : tobjectdef;
constrsym : tsymentry;
typesym : ttypesym;
parasok : boolean;
begin
consume(_LECKKLAMMER);
@ -471,6 +472,7 @@ implementation
{ only count visible parameters (thankfully open arrays are not
supported, otherwise we'd need to handle those as well) }
parasok:=true;
paras:=nil;
if assigned(paran) then
begin
@ -490,7 +492,10 @@ implementation
if not (vo_is_hidden_para in tcallparanode(ptmp).parasym.varoptions) then
begin
if not is_constnode(tcallparanode(ptmp).left) then
internalerror(2019070601);
begin
parasok:=false;
messagepos(tcallparanode(ptmp).left.fileinfo,type_e_constant_expr_expected);
end;
paras[high(paras)-pcount]:=tcallparanode(ptmp).left.getcopy;
inc(pcount);
end;
@ -498,12 +503,21 @@ implementation
end;
end;
{ Add attribute to attribute list which will be added
to the property which is defined next. }
if not assigned(rtti_attrs_def) then
rtti_attrs_def:=trtti_attribute_list.create;
rtti_attrs_def.addattribute(typesym,tcallnode(pcalln).procdefinition,pcalln,paras);
if parasok then
begin
{ Add attribute to attribute list which will be added
to the property which is defined next. }
if not assigned(rtti_attrs_def) then
rtti_attrs_def:=trtti_attribute_list.create;
rtti_attrs_def.addattribute(typesym,tcallnode(pcalln).procdefinition,pcalln,paras);
end
else
begin
{ cleanup }
pcalln.free;
for i:=0 to high(paras) do
paras[i].free;
end;
end
else
pcalln.free;

55
tests/webtbf/tw35866.pp Normal file
View File

@ -0,0 +1,55 @@
{ %FAIL }
program tw35866;
{$mode delphi}{$warn 5079 off} // turn warning experimental off
uses
sysutils, dateutils, typinfo, rtti, classes;
type
{$M+}
TDateTimeAttribute = class(TCustomAttribute)
private
FArg:TDateTime;
public
constructor Create(aArg: String);overload;
constructor Create(aArg: TDateTime);overload;
constructor Create(aArg: int64);overload;
property DateTime:TDateTime read Farg;
end;
//[TDateTimeAttribute]
TMyDateTimeClass = class
private
FDateTime:TDateTime;
published
[TDateTimeAttribute(Now)]
property DateTime:TDateTime read FDateTime;
end;
constructor TDateTimeAttribute.Create(aArg: String);
begin
inherited create;
FArg := StrToDateTime(aArg);
end;
constructor TDateTimeAttribute.Create(aArg: TDateTime);
begin
FArg := aArg;
end;
constructor TDateTimeAttribute.Create(aArg: int64);
begin
//FArg := UnixToDateTime(aArg);
end;
var
Test:TMyDateTimeClass;
begin
Test := TMyDateTimeClass.Create;
try
writeln(DateTimeToStr(Test.DateTime));
finally
test.free;
end;
end.