Changeset aca1089 in tol for toltcl/generic


Ignore:
Timestamp:
Jul 2, 2009, 1:37:55 PM (17 years ago)
Author:
Jorge Pérez <josp.jorge@…>
Branches:
1941-docker-image-to-test, devel, master
Children:
9e3cbcf
Parents:
8960892
Message:

merging from branch 1.1.7, releted to #704 & #705

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@1131 be4846ae-f051-483a-831f-b64e7d08527f

File:
1 edited

Legend:

Unmodified
Added
Removed

  • toltcl/generic/tolaccess.cpp

    r8960892 raca1089  
    5252 */
    5353
    54 /* #define ISFILE_IMPLEMENTED */
     54#define ISFILE_IMPLEMENTED
    5555
    5656typedef void (* getmethod)( const BSyntaxObject *, BText & );
    … …  
    803803 * {i1,i2,...,ik}
    804804 *
     805 * Used by tol::forallchil
     806 *
    805807 */
    806808
    … …  
    810812                     Tcl_Obj * obj_result)
    811813{
    812 #define ARG_SCRIPT    0
    813 #define ARG_GRAMMAR   ARG_SCRIPT+1
    814 #define ARG_NAME      ARG_GRAMMAR+1
    815 #define ARG_CONTENT   ARG_NAME+1
    816 #define ARG_PATH      ARG_CONTENT+1
    817 #define ARG_DESC      ARG_PATH+1
    818 #define ARG_INDEXES   ARG_DESC+1
    819 #define ARG_ISFILE    ARG_INDEXES+1
    820 #define ARG_HASSUBSET ARG_ISFILE+1
    821 #define ARG_SUBTYPE   ARG_HASSUBSET+1
    822 #define ARG_STRUCT    ARG_SUBTYPE+1
    823 #define NUM_ARGS      ARG_STRUCT+1
    824 
    825814  const BSyntaxObject* container;
    826815  Tcl_DString dstr;
    … …  
    830819  int n, index_length;
    831820  Tcl_Obj ** items;
     821  Tcl_Obj ** script_header;
    832822
    833823  int length = 0;
    … …  
    837827    return TCL_ERROR;
    838828  }
    839   if (length<2) {
    840     Tcl_AppendStringsToObj(obj_result,
    841                            "invalid object reference '",
    842                            Tcl_GetString(objv[0]),
    843                            "must be {TYPE ?name? i1 i2 ... ik}",
    844                            NULL);
    845     return TCL_ERROR;
    846   }
    847 
    848   if (!(container=Tol_ResolveObject(interp, objv[0], obj_result))) {
    849     return TCL_ERROR;
    850   }
    851   BSet *set = ContainerGetSet(container);
     829  if ( length < 2 ) {
     830    Tcl_AppendStringsToObj( obj_result,
     831                            "invalid object reference '",
     832                            Tcl_GetString(objv[0]),
     833                            "must be {TYPE ?name? i1 i2 ... ik}",
     834                            NULL );
     835    return TCL_ERROR;
     836  }
     837
     838  /* expand header of script */
     839  tcl_code = Tcl_ListObjGetElements( interp, objv[ 1 ],
     840                                     &length, &script_header );
     841  if ( tcl_code != TCL_OK ) {
     842    Tcl_AppendObjToObj( obj_result, Tcl_GetObjResult( interp ) );
     843    return TCL_ERROR;
     844  }
     845
     846  if ( !length ) {
     847    Tcl_AppendStringsToObj( obj_result,
     848                            "invalid script argument of length 0",
     849                            NULL );
     850    return TCL_ERROR;
     851  }
     852  int ARG_SCRIPT    = length - 1;
     853  int ARG_GRAMMAR   = ARG_SCRIPT + 1;
     854  int ARG_NAME      = ARG_GRAMMAR + 1;
     855  int ARG_CONTENT   = ARG_NAME + 1;
     856  int ARG_PATH      = ARG_CONTENT + 1;
     857  int ARG_DESC      = ARG_PATH + 1;
     858  int ARG_INDEXES   =  ARG_DESC + 1;
     859  int ARG_ISFILE    = ARG_INDEXES + 1;
     860  int ARG_HASSUBSET = ARG_ISFILE + 1;
     861  int ARG_SUBTYPE   = ARG_HASSUBSET + 1;
     862  int ARG_STRUCT    = ARG_SUBTYPE + 1;
     863  int NUM_ARGS      = ARG_STRUCT + 1;
     864 
     865  if ( !( container=Tol_ResolveObject( interp, objv[0], obj_result ) ) ) {
     866    return TCL_ERROR;
     867  }
     868  BSet *set = ContainerGetSet( container );
    852869  if (!set) {
    853870    Tcl_AppendStringsToObj(obj_result,
    … …  
    862879 
    863880  int datac;
    864   Tcl_Obj * datav[NUM_ARGS];
     881  Tcl_Obj ** datav = new ( Tcl_Obj* [ NUM_ARGS ] );
     882
    865883  // is ok to ask for a list
    866   Tcl_ListObjGetElements(interp,objv[0],&n,&items);
     884  Tcl_ListObjGetElements( interp, objv[ 0 ], &n, &items );
    867885 
    868886  if (strcmp(Tcl_GetString(items[0]),"Console")) {
    … …  
    878896  }
    879897
    880   datav[ARG_SCRIPT] = objv[1];
     898  for( i = 0; i < ARG_GRAMMAR; ++i ) {
     899    datav[ i ] = script_header[ i ];
     900  }
    881901 
    882902  datav[ARG_GRAMMAR] = Tcl_NewObj();
    … …  
    893913  datav[ARG_SUBTYPE] = Tcl_NewObj();
    894914  datav[ARG_STRUCT] = Tcl_NewObj();
    895   for (i=ARG_GRAMMAR; i<NUM_ARGS; ++i)
    896     Tcl_IncrRefCount(datav[i]);
     915  for ( i = 0; i < NUM_ARGS; ++i ) {
     916    Tcl_IncrRefCount( datav[i] );
     917  }
    897918 
    898919  BSyntaxObject *syn_i;
    … …  
    902923  Tcl_DStringInit(&dstr);
    903924  BText btxt;
    904  
    905925 
    906   for (i=1; i<=card; ++i) {
     926  for ( i = 1; i <= card; ++i ) {
    907927    syn_i = (*set)[i];
    908928   
    909929    /* read the grammar */
    910    
    911930    btxt = syn_i->Grammar()->Name();
    912931    Tcl_ExternalToUtfDString(NULL,btxt,-1,&dstr);
    … …  
    920939   
    921940    /* read the name */
    922    
    923941    //btxt = syn_i->Identify();
    924942    GetName( syn_i, btxt );
    … …  
    933951   
    934952    /* read the content */
    935    
    936953    btxt = syn_i->Info();
    937954    Tcl_ExternalToUtfDString(NULL,btxt,-1,&dstr);
    … …  
    945962   
    946963    /* read the path */
    947    
    948964    btxt = syn_i->SourcePath();
    949965    Tcl_ExternalToUtfDString(NULL,btxt,-1,&dstr);
    … …  
    956972    Tcl_DStringFree(&dstr);
    957973   
    958     /* read the description */
    959    
     974    /* read the description */   
    960975    btxt = syn_i->Description();
    961976    Tcl_ExternalToUtfDString(NULL,btxt,-1,&dstr);
    … …  
    975990                           1, 1, &last_index);
    976991      }
    977       /*
    978       if (Tcl_IsShared(datav[ARG_INDEXES])) {
    979         Tcl_DecrRefCount(datav[ARG_INDEXES]);
    980         datav[ARG_INDEXES] = Tcl_DuplicateObj(datav[ARG_INDEXES]);
    981         Tcl_IncrRefCount(datav[ARG_INDEXES]);
    982         Tcl_ListObjLength(NULL,datav[ARG_INDEXES],&n);
    983         Tcl_ListObjIndex(NULL,datav[ARG_INDEXES],n-1,&last_index);
    984       }
    985       */
    986992      /* set the last value index */
    987       Tcl_SetIntObj(last_index,i);
     993      Tcl_SetIntObj( last_index, i );
    988994      /* to refresh the string */
    989       Tcl_InvalidateStringRep(datav[ARG_INDEXES]);
    990       if (Tcl_IsShared(datav[ARG_ISFILE])) {
    991         Tcl_DecrRefCount(datav[ARG_ISFILE]);
     995      Tcl_InvalidateStringRep( datav[ ARG_INDEXES ] );
     996      if ( Tcl_IsShared( datav[ ARG_ISFILE ] ) ) {
     997        Tcl_DecrRefCount( datav[ ARG_ISFILE ] );
    992998#ifdef ISFILE_IMPLEMENTED
    993         datav[ARG_ISFILE] = Tcl_NewIntObj(syn_i->IsFile());
     999        datav[ ARG_ISFILE ] = Tcl_NewIntObj( syn_i->IsFile( ) );
    9941000#else
    995         datav[ARG_ISFILE] = Tcl_NewIntObj(0);
     1001        datav[ARG_ISFILE] = Tcl_NewIntObj( 0 );
    9961002#endif
    997         Tcl_IncrRefCount(datav[ARG_ISFILE]);
     1003        Tcl_IncrRefCount( datav[ ARG_ISFILE ] );
    9981004      } else
    9991005#ifdef ISFILE_IMPLEMENTED
    1000         Tcl_SetIntObj(datav[ARG_ISFILE],syn_i->IsFile());
     1006        Tcl_SetIntObj( datav[ ARG_ISFILE ], syn_i->IsFile( ) );
    10011007#else
    1002       Tcl_SetIntObj(datav[ARG_ISFILE],0);
     1008      Tcl_SetIntObj( datav[ ARG_ISFILE ], 0 );
    10031009#endif
    10041010      /* verify if has subset */
    1005       int tmpCard = set_i->Card();
     1011      int tmpCard = set_i->Card( );
    10061012      int j;
    10071013      for (j=1; j<=tmpCard; ++j )
    1008         if (ContainerGetSet((*set_i)[j]))
     1014        if ( ContainerGetSet( ( *set_i )[ j ] ) )
    10091015          break;
    1010       if (Tcl_IsShared(datav[ARG_HASSUBSET])) {
    1011         Tcl_DecrRefCount(datav[ARG_HASSUBSET]);
    1012         datav[ARG_HASSUBSET] = Tcl_NewIntObj(j<=tmpCard);
    1013         Tcl_IncrRefCount(datav[ARG_HASSUBSET]);
     1016      if ( Tcl_IsShared( datav[ ARG_HASSUBSET ] ) ) {
     1017        Tcl_DecrRefCount( datav[ ARG_HASSUBSET ] );
     1018        datav[ ARG_HASSUBSET ] = Tcl_NewIntObj( j <= tmpCard );
     1019        Tcl_IncrRefCount( datav[ ARG_HASSUBSET ] );
    10141020      } else
    1015         Tcl_SetIntObj(datav[ARG_HASSUBSET],j<=tmpCard);
     1021        Tcl_SetIntObj( datav[ ARG_HASSUBSET ], j <= tmpCard );
    10161022       
    10171023      /* subtype info */
    1018        
    1019       if (Tcl_IsShared(datav[ARG_SUBTYPE])) {
    1020         Tcl_DecrRefCount(datav[ARG_SUBTYPE]);
    1021         datav[ARG_SUBTYPE] = Tcl_NewIntObj(set_i->SubType());
    1022         Tcl_IncrRefCount(datav[ARG_SUBTYPE]);
     1024      if ( Tcl_IsShared( datav[ ARG_SUBTYPE ] ) ) {
     1025        Tcl_DecrRefCount( datav[ ARG_SUBTYPE ] );
     1026        datav[ ARG_SUBTYPE ] = Tcl_NewIntObj( set_i->SubType( ) );
     1027        Tcl_IncrRefCount( datav[ ARG_SUBTYPE ] );
    10231028      } else
    1024         Tcl_SetIntObj(datav[ARG_SUBTYPE],set_i->SubType());
     1029        Tcl_SetIntObj( datav[ ARG_SUBTYPE ],set_i->SubType( ) );
    10251030       
    10261031      /* STRUCT INFO */
    1027       if ( set_i->Struct() ) {
    1028         btxt = set_i->Struct()->Name();
    1029         Tcl_ExternalToUtfDString(NULL,btxt,-1,&dstr);
     1032      if ( set_i->Struct( ) ) {
     1033        btxt = set_i->Struct( )->Name( );
     1034        Tcl_ExternalToUtfDString( NULL, btxt, -1, &dstr );
    10301035      }
    1031       if (Tcl_IsShared(datav[ARG_STRUCT])) {
    1032         Tcl_DecrRefCount(datav[ARG_STRUCT]);
    1033         datav[ARG_STRUCT] = Tcl_NewStringObj(Tcl_DStringValue(&dstr),-1);
    1034         Tcl_IncrRefCount(datav[ARG_STRUCT]);
     1036      if ( Tcl_IsShared( datav[ ARG_STRUCT ] ) ) {
     1037        Tcl_DecrRefCount( datav[ ARG_STRUCT ] );
     1038        datav[ ARG_STRUCT ] = Tcl_NewStringObj( Tcl_DStringValue( &dstr ),-1 );
     1039        Tcl_IncrRefCount( datav[ ARG_STRUCT ] );
    10351040      } else
    1036         Tcl_SetStringObj(datav[ARG_STRUCT],Tcl_DStringValue(&dstr),-1);
    1037       Tcl_DStringFree(&dstr);
     1041        Tcl_SetStringObj( datav[ ARG_STRUCT ], Tcl_DStringValue( &dstr ),-1 );
     1042      Tcl_DStringFree( &dstr );
    10381043      datac = NUM_ARGS;
    10391044    } else
    10401045      datac = ARG_INDEXES;
    1041     tcl_code = Tcl_EvalObjv(interp,datac,datav,TCL_EVAL_GLOBAL);
    1042     if (tcl_code != TCL_OK) {
    1043       /* liberar los objetos tcl */
    1044       for (i=ARG_GRAMMAR; i<NUM_ARGS; ++i)
    1045         Tcl_DecrRefCount(datav[i]);
    1046       Tcl_AppendObjToObj(obj_result,Tcl_GetObjResult(interp));
    1047       return tcl_code;
    1048     }
    1049     /* check if break loop */
    1050     cont_loop = 1;
    1051     tcl_code = Tcl_GetIntFromObj(interp,Tcl_GetObjResult(interp),&cont_loop);
    1052     if (tcl_code == TCL_OK && !cont_loop)
     1046    tcl_code = Tcl_EvalObjv( interp, datac, datav, TCL_EVAL_GLOBAL );
     1047    if ( tcl_code == TCL_BREAK ) {
     1048      tcl_code = TCL_OK;
    10531049      break;
     1050    }
     1051    if ( tcl_code == TCL_ERROR ) {
     1052      Tcl_AppendObjToObj( obj_result, Tcl_GetObjResult( interp ) );
     1053      break;
     1054    }
    10541055  }
    10551056 
    10561057  /* liberar los objetos tcl */
    1057   for (i=ARG_GRAMMAR; i<NUM_ARGS; ++i)
    1058     Tcl_DecrRefCount(datav[i]);
    1059   return TCL_OK;
     1058  /* OJO aqui tenia ARG_GRAMMAR en lugar de 0 */
     1059  for ( i = 0; i < NUM_ARGS; ++i ) {
     1060    Tcl_DecrRefCount( datav[ i ] );
     1061  }
     1062  delete []datav;
     1063  return tcl_code;
    10601064}
    10611065
    … …  
    14081412  char * pch = soInfo;
    14091413  if (pch) pch = skipWhite(pch);
    1410   else pch = "";
     1414  else pch = (char*)"";
    14111415
    14121416  Tcl_ExternalToUtfDString(NULL,pch,-1,&dstr);
    … …  
    17621766
    17631767  /* GRAMMAR */
    1764   info[0] = Tcl_NewStringObj(var->Grammar()->Name().String(), -1);
     1768#ifdef ISFILE_IMPLEMENTED
     1769  info[ 0 ] = Tcl_NewStringObj(var->IsFile( ) ? "File" :
     1770                               var->Grammar( )->Name( ).String( ), -1 );
     1771#else
     1772  info[ 0 ] = Tcl_NewStringObj( var->Grammar( )->Name( ).String( ), -1 );
     1773#endif
    17651774   
    17661775  /* NAME */
    … …  
    17801789  /* OBJECT CONTENT */
    17811790  char * pch = varInfo;
     1791 
    17821792  if (pch) pch = skipWhite(pch);
    1783   else pch = "";
     1793  else pch = (char*)"";
    17841794 
    17851795  Tcl_ExternalToUtfDString(NULL,pch,-1,&dstr);
    … …  
    19341944
    19351945/*
     1946 * Fill in obj_result the string representation of the
     1947 * address of the object referenced in obj_ref.
     1948 */
     1949int Tol_GetAddresFromObject( Tcl_Interp * interp,
     1950                             Tcl_Obj * obj_ref,
     1951                             Tcl_Obj * obj_result)
     1952{
     1953  const BSyntaxObject *syn ;
     1954
     1955#ifndef _NDEBUG
     1956#define _PRINT_ADDR_OBJREF_
     1957#endif
     1958
     1959#ifdef _PRINT_ADDR_OBJREF_
     1960  printf( "obj_ref = %s\n", Tcl_GetString( obj_ref ) );
     1961#endif
     1962
     1963  if ( !( syn = Tol_ResolveObject( interp, obj_ref, obj_result ) ) ) {
     1964    return TCL_ERROR;
     1965  }
     1966  BText addr = syn->GetAddressFromObject( );
     1967  Tcl_AppendStringsToObj( obj_result, addr.Buffer( ), NULL );
     1968  return TCL_OK;
     1969}
     1970                           
     1971/*
    19361972 * We must be sure that the strings use 7 bit ASCII chararters.
    19371973 * Otherwise we must take care of the Utf representation.
    … …  
    20642100}
    20652101
    2066 Tcl_Obj *TolObj2TclObj(BSyntaxObject *tolObj)
    2067 {
    2068   const char *grammar = tolObj->Grammar()->Name().String();
    2069 
    2070   if (!strcmp(grammar, "Text")) {
    2071     const BText &value = Text(tolObj);
    2072     return Tcl_NewStringObj(value.String(),-1);
    2073   } else if (!strcmp(grammar, "Real")) {
    2074     const BDat &value = Dat(tolObj);
    2075     return Tcl_NewDoubleObj(value.Value());
     2102Tcl_Obj *TolObj2TclObj( BSyntaxObject *tolObj )
     2103{
     2104  const char *grammar = tolObj->Grammar( )->Name( ).String( );
     2105
     2106  if ( !strcmp( grammar, "Text" ) ) {
     2107    const BText &value = Text( tolObj );
     2108    return Tcl_NewStringObj( value.String( ),-1 );
     2109  } else if ( !strcmp( grammar, "Real" ) ) {
     2110    const BDat &value = Dat( tolObj );
     2111    return Tcl_NewDoubleObj( value.Value( ) );
     2112  } else if ( !strcmp( grammar, "Set" ) ) {
     2113    // a Tol Set maps to a Tcl list
     2114    const BSet &setObj = ( ( BUserSet* )tolObj )->Contens( );
     2115    int card = setObj.Card( );
     2116    Tcl_Obj **objv = ( Tcl_Obj** )Tcl_Alloc( sizeof( Tcl_Obj* ) * card );
     2117    for( int i = 1; i <= card; i++ ) {
     2118      objv[ i - 1 ] = TolObj2TclObj( setObj[ i ] );
     2119    }
     2120    Tcl_Obj *listObj = Tcl_NewListObj( card, objv );
     2121    Tcl_Free( ( char* )objv );
     2122    return listObj;
    20762123  } else {
    2077     return Tcl_NewStringObj(tolObj->Dump().String(),-1);   
    2078   }
    2079 }
    2080 
    2081 int Tol_Tcl_EvalEx(const BSet &Args, const char ** result)
     2124    // other types are not treated
     2125    return Tcl_NewStringObj( tolObj->Dump( ).String( ),-1 );   
     2126  }
     2127}
     2128
     2129int Tol_Tcl_EvalEx( const BSet &Args, const char ** result )
    20822130{
    20832131  int status;
    20842132  Tcl_Obj **objv;
    2085   int card = Args.Card();
    2086  
    2087   if (!Args.Card()) {
     2133  int card = Args.Card( );
     2134 
     2135  if ( !Args.Card( ) ) {
    20882136    *result = "";
    20892137    status = TCL_OK;
    20902138  } else {
    2091     objv = (Tcl_Obj**)Tcl_Alloc(sizeof(Tcl_Obj*)*card);
    2092     for(int i=1; i<=card; i++) {
    2093       objv[i-1] = TolObj2TclObj(Args[i]);
    2094       Tcl_IncrRefCount(objv[i-1]);
    2095     }
    2096     status = Tcl_EvalObjv(TT_interp, card, objv, TCL_EVAL_GLOBAL);
    2097     *result = Tcl_GetStringResult(TT_interp);
    2098     for(int i=0; i<card; i++) {
     2139    objv = ( Tcl_Obj** )Tcl_Alloc( sizeof( Tcl_Obj* ) * card );
     2140    for( int i=1; i<=card; i++ ) {
     2141      objv[ i-1 ] = TolObj2TclObj( Args[i] );
     2142      Tcl_IncrRefCount( objv[ i - 1 ] );
     2143    }
     2144    status = Tcl_EvalObjv( TT_interp, card, objv, TCL_EVAL_GLOBAL );
     2145    *result = Tcl_GetStringResult( TT_interp );
     2146    for( int i = 0; i < card; i++ ) {
    20992147      Tcl_DecrRefCount(objv[i]);
    21002148    }
Note: See TracChangeset for help on using the changeset viewer.