* support indexed stored methods

git-svn-id: trunk@4740 -

.gitattributes

@@ -7338,6 +7338,7 @@ tests/webtbs/tw7227.pp svneol=native#text/plain
 tests/webtbs/tw7276.pp svneol=native#text/plain
 tests/webtbs/tw7372.pp svneol=native#text/plain
 tests/webtbs/tw7379.pp svneol=native#text/plain
+tests/webtbs/tw7391.pp svneol=native#text/plain
 tests/webtbs/tw7425.pp svneol=native#text/plain
 tests/webtbs/tw7440.pp svneol=native#text/plain
 tests/webtbs/tw7446.pp svneol=native#text/plain

compiler/pdecvar.pas

@@ -224,6 +224,7 @@ implementation
          intfidx: longint;
          hreadparavs,
          hparavs      : tparavarsym;
+         storedprocdef,
          readprocdef,
          writeprocdef : tprocvardef;
       begin
@@ -232,14 +233,19 @@ implementation
          paranr:=0;
          readprocdef:=tprocvardef.create(normal_function_level);
          writeprocdef:=tprocvardef.create(normal_function_level);
+         storedprocdef:=tprocvardef.create(normal_function_level);
 
          { make it method pointers }
          if assigned(aclass) then
            begin
              include(readprocdef.procoptions,po_methodpointer);
              include(writeprocdef.procoptions,po_methodpointer);
+             include(storedprocdef.procoptions,po_methodpointer);
            end;
 
+         { method for stored must return boolean }
+         storedprocdef.rettype:=booltype;
+
          if token<>_ID then
            begin
               consume(_ID);
@@ -351,6 +357,8 @@ implementation
                    readprocdef.parast.insert(hparavs);
                    hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indextype,[]);
                    writeprocdef.parast.insert(hparavs);
+                   hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indextype,[]);
+                   storedprocdef.parast.insert(hparavs);
                    pt.free;
                 end;
            end
@@ -505,7 +513,9 @@ implementation
                             case sym.typ of
                               procsym :
                                 begin
-                                   p.storedaccess.procdef:=Tprocsym(sym).search_procdef_nopara_boolret;
+                                   { Insert hidden parameters }
+                                   handle_calling_convention(storedprocdef);
+                                   p.storedaccess.procdef:=Tprocsym(sym).search_procdef_bypara(storedprocdef.paras,storedprocdef.rettype.def,[cpo_allowdefaults,cpo_ignorehidden]);
                                    if not assigned(p.storedaccess.procdef) then
                                      message(parser_e_ill_property_storage_sym);
                                 end;
@@ -623,7 +633,7 @@ implementation
              end;
            end;
          end;
-                  
+
          { remove temporary procvardefs }
          readprocdef.free;
          writeprocdef.free;

compiler/symsym.pas

@@ -108,7 +108,6 @@ interface
           procedure foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
           function first_procdef:Tprocdef;
           function last_procdef:Tprocdef;
-          function search_procdef_nopara_boolret:Tprocdef;
           function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
           function search_procdef_bypara(para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
           function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
@@ -812,25 +811,6 @@ implementation
       end;
 
 
-    function Tprocsym.search_procdef_nopara_boolret:Tprocdef;
-      var
-        p : pprocdeflist;
-      begin
-        search_procdef_nopara_boolret:=nil;
-        p:=pdlistfirst;
-        while p<>nil do
-         begin
-           if (p^.def.maxparacount=0) and
-              is_boolean(p^.def.rettype.def) then
-            begin
-              search_procdef_nopara_boolret:=p^.def;
-              break;
-            end;
-           p:=p^.next;
-         end;
-      end;
-
-
     function Tprocsym.search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
       var
         p : pprocdeflist;

tests/webtbs/tw7391.pp

@@ -0,0 +1,37 @@
+{$Ifdef fpc}{$mode objfpc}{$h+}{$endif}
+uses
+  Classes;
+type
+  TGLNode = class (TCollectionItem)
+  private
+    FCoords : array[0..2] of Byte;
+    procedure SetCoordinate(Indx: Integer; AValue: Byte);
+  protected
+    function StoreCoordinate(Indx: Integer) : Boolean;
+  published
+    property X: Byte index 0 read FCoords[0] write SetCoordinate stored StoreCoordinate;
+    property Y: Byte index 1 read FCoords[1] write SetCoordinate stored StoreCoordinate;
+    property Z: Byte index 2 read FCoords[2] write SetCoordinate stored StoreCoordinate;
+end;
+
+{ TGLNode }
+
+procedure TGLNode.SetCoordinate(Indx: Integer; AValue: Byte);
+begin
+  FCoords[Indx]:=AValue;
+end;
+
+function TGLNode.StoreCoordinate(Indx: Integer): Boolean;
+begin
+  result:=(FCoords[Indx] <> 0);
+end;
+
+var
+  n : TGLNode;
+begin
+  n:=TGLNode.Create(nil);
+  n.X:=1;
+  n.Y:=2;
+  n.Z:=3;
+  writeln(n.X,',',n.Y,',',n.Z);
+end.