[PATCH] fix #{...} literal that are made read-only

This is a bug present also in 2.3; the read-onlyness must be set
selectively in make_oop_constant rather than "one catches all" in
compile_constant.

Paolo

--- orig/libgst/comp.c
+++ mod/libgst/comp.c
@@ -1101,8 +1101,6 @@ compile_constant (tree_node constExpr)
       return;
     }
         }
-      else
-        MAKE_OOP_READONLY (constantOOP, true);
 
       index = add_literal (constantOOP);
     }
@@ -2134,9 +2132,8 @@ make_constant_oop (tree_node constExpr)
   elementOOP = make_constant_oop (arrayElt->v_list.value);
   result = OOP_TO_OBJ (resultOOP);
   result->data[i] = elementOOP;
-  if (IS_OOP (elementOOP))
-    MAKE_OOP_READONLY (elementOOP, true);
  }
+      MAKE_OOP_READONLY (resultOOP, true);
       INC_RESTORE_POINTER (incPtr);
       return (resultOOP);
     }
@@ -2159,7 +2156,9 @@ make_constant_oop (tree_node constExpr)
       return (floatq_new (constExpr->v_const.val.fVal));
 
     case CONST_STRING:
-      return (_gst_string_new (constExpr->v_const.val.sVal));
+      resultOOP = _gst_string_new (constExpr->v_const.val.sVal);
+      MAKE_OOP_READONLY (resultOOP, true);
+      return (resultOOP);
 
     case CONST_OOP:
       return (constExpr->v_const.val.oopVal);
@@ -2168,6 +2167,7 @@ make_constant_oop (tree_node constExpr)
       bo = constExpr->v_const.val.boVal;
       result = instantiate_with (bo->class, bo->size, &resultOOP);
       memcpy (result->data, bo->body, bo->size);
+      MAKE_OOP_READONLY (resultOOP, true);
       return (resultOOP);
 
     case CONST_BINDING:
@@ -2196,10 +2196,9 @@ make_constant_oop (tree_node constExpr)
   elementOOP = make_constant_oop (arrayElt->v_list.value);
   result = OOP_TO_OBJ (resultOOP);
   result->data[i] = elementOOP;
-  if (IS_OOP (elementOOP))
-    MAKE_OOP_READONLY (elementOOP, true);
  }
 
+      MAKE_OOP_READONLY (resultOOP, true);
       INC_RESTORE_POINTER (incPtr);
       return (resultOOP);
     }


--- orig/libgst/dict.inl
+++ mod/libgst/dict.inl
@@ -463,6 +463,7 @@ floate_new (double f)
     (_gst_floate_class, sizeof (float), &floatOOP);
 
   floatObject->value = f;
+  MAKE_OOP_READONLY (floatOOP, true);
   return (floatOOP);
 }
 
@@ -507,6 +508,7 @@ floatd_new (double f)
   memcpy (&obj->data, &f, sizeof (double));
 #endif
 
+  MAKE_OOP_READONLY (floatOOP, true);
   return (floatOOP);
 }
 
@@ -551,6 +553,7 @@ floatq_new (long double f)
   memcpy (&obj->data, &f, sizeof (long double));
 #endif
 
+  MAKE_OOP_READONLY (floatOOP, true);
   return (floatOOP);
 }
 
@@ -567,6 +570,7 @@ char_new (int codePoint)
   charObject = (gst_char) new_instance (_gst_unicode_character_class, &charOOP);
 
   charObject->codePoint = FROM_INT (codePoint);
+  MAKE_OOP_READONLY (charOOP, true);
   return (charOOP);
 }
 


--- orig/libgst/lex.c
+++ mod/libgst/lex.c
@@ -894,6 +894,7 @@ scan_number (int c,
 
  /* incubator is set up by _gst_compile_method */
  INC_ADD_OOP (lvalp->oval);
+ MAKE_OOP_READONLY (lvalp->oval, true);
  return (SCALED_DECIMAL_LITERAL);
       }
     while (0);



_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk