From 2c7bc12ad66b1693d2a65606c8ce7e69f6e2bb43 Mon Sep 17 00:00:00 2001
From: peter <peter@freepascal.org>
Date: Wed, 27 Sep 2006 18:32:18 +0000
Subject: [PATCH]   * support indexed stored methods

git-svn-id: trunk@4740 -
---
 .gitattributes         |  1 +
 compiler/pdecvar.pas   | 14 ++++++++++++--
 compiler/symsym.pas    | 20 --------------------
 tests/webtbs/tw7391.pp | 37 +++++++++++++++++++++++++++++++++++++
 4 files changed, 50 insertions(+), 22 deletions(-)
 create mode 100755 tests/webtbs/tw7391.pp

diff --git a/.gitattributes b/.gitattributes
index 4407a597f8..44ef98494c 100644
--- a/.gitattributes
+++ b/.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
diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas
index ff24ed5d93..363c8c2dec 100644
--- a/compiler/pdecvar.pas
+++ b/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;
diff --git a/compiler/symsym.pas b/compiler/symsym.pas
index 4f1c87108c..811fbde218 100644
--- a/compiler/symsym.pas
+++ b/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;
diff --git a/tests/webtbs/tw7391.pp b/tests/webtbs/tw7391.pp
new file mode 100755
index 0000000000..206658a913
--- /dev/null
+++ b/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.