bug 5588 fix
[scilab.git] / scilab / modules / data_structures / src / fortran / followpath.f
index e959760..06bad1f 100644 (file)
@@ -1,12 +1,19 @@
+c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+c Copyright (C) ????-2008 - INRIA
+c
+c This file must be used under the terms of the CeCILL.
+c This source file is licensed as described in the file COPYING, which
+c you should have received as part of this distribution.  The terms
+c are also available at
+c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
       subroutine followpath(indtop,listtop,ilindi,voli,ilp,voll,ind,
-     $     count,info,lwork)
-c     Copyright INRIA
+     $     count,info,lwork,job)
 c =============================================================
-c     given 
-c     - a path stored in a "linear" index list ind stored in the 
+c     given
+c     - a path stored in a "linear" index list ind stored in the
 c     variable number indtop
-c     and 
-c     - a list L begining at position stored in the 
+c     and
+c     - a list L begining at position stored in the
 c     variable number listtop
 
 c     - a current pointer on index list entries count
@@ -14,7 +21,7 @@ c     - a current pointer on index list entries count
 c     returns:
 c     - the pointer ilp on the deapest sublist of L on the path indtop
 c       available just by following the list structure of L.
-c       i.e. ilp is the pointer on the sublist of L pointed to by 
+c       i.e. ilp is the pointer on the sublist of L pointed to by
 c       the path indtop(1:count)
 c     - the vector of numerical indexes corresponding to indtop(1:count)
 
@@ -26,14 +33,21 @@ c     info
 c         1 : unknown named field
 c         2 : current index is a matrix index of an mlist
 c         3 : current index is not a single number
-c         4 : current index points to a leaf of the  L list 
+c         4 : current index points to a leaf of the  L list
 c         5 : end of index list reached
-c         6 : current index is 0 or greater than current sublist # of fields
+c         6 : current index is 0 or greater than current sublist # of
+c             fields
+c     job
+c     if job is true and end of index list is reached, the last index is
+c     a name and the parent of the deapest object is a tlist or an mlist
+c     the procedure returns the pointer and path of the parent instead
+c     of the object itself (null insertion).
+
 c =============================================================
 c
-c     Copyright INRIA
       include 'stack.h'
-c     
+c
+      logical job
       integer indtop,listtop,ind(*)
       integer typi,count,oldcount,voll,voli
 
@@ -45,7 +59,7 @@ c
       sadr(l)=(l/2)+1
 c
       oldcount=count
-c     
+c
       ilind=iadr(lstk(indtop))
       if(istk(ilind).lt.0) then
          itop=istk(ilind+2)
@@ -57,16 +71,12 @@ c
       endif
 c
       illist=iadr(lstk(listtop))
-c      if(istk(illist).lt.0) illist=iadr(istk(illist+1))
-c
       if(istk(ilind).ne.15) then
 c     .  special case if ind is not a list
          nlist=1
          count=1
          ilindi=ilind
          ilindir=ilindi
-c        voli=lstk(itop+1)-lstk(itop)
-
          illistir=illist
          if(istk(illist).lt.0) illist=iadr(istk(illist+1))
          illisti=illist
@@ -74,6 +84,7 @@ c        voli=lstk(itop+1)-lstk(itop)
 
       endif
 
+c     nlist is the size of the path index list
       nlist=istk(ilind+1)
       ll=sadr(ilind+3+nlist)
 
@@ -95,11 +106,17 @@ c     extract infos out of the current sublist
       llisti=sadr(illisti+mi+3)
       voll=istk(illisti+mi+2)-1+sadr(3+mi)
 c     go ahead along the path
+
+      if(typi.eq.13.or.typi.eq.11) then
+c     .  not an extraction but a function call
+         info=2
+         goto 50
+      endif
+
 c
       if(istk(ilindi).eq.10) then
 c     .  current element index is a name
-
-         if(istk(ilindi+1)*istk(ilindi+2).ne.1) then
+         if (istk(ilindi+1)*istk(ilindi+2).ne.1) then
             info=3
             goto 50
 c            call error(21)
@@ -120,11 +137,14 @@ c     .     first field may contain the fields names
             lfn=ilptr+nn
 c     .     look for corresponding index if any
             n=strpos(istk(ilptr),nn-1,istk(lfn),istk(ilname),nname)
-
             if(n.le.0) then
 c     .        no such name in the field names
                info=1
                goto 50
+            elseif(job.and.count.eq.nlist) then
+c     .        null assignment into a named sublist of an tlist or mlist
+               info=1
+               goto 50
             endif
             n=n+1
          endif
@@ -178,7 +198,7 @@ c      if(voll.eq.0) then
 c     .  undefined field found
 c         info=7
 c         goto 50
-c     
+c
 c     endif
       if(istk(illisti).lt.0) then
          kk=istk(illisti+2)