ソースを参照

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

git-svn-id: trunk@42469 -

svenbarth 6 年 前
コミット
6cde8ab4cb
3 ファイル変更78 行追加8 行削除
  1. 1 0
      .gitattributes
  2. 22 8
      compiler/pdecl.pas
  3. 55 0
      tests/webtbf/tw35866.pp

+ 1 - 0
.gitattributes

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

+ 22 - 8
compiler/pdecl.pas

@@ -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 - 0
tests/webtbf/tw35866.pp

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