Add Assertion check when assigning already assigned Attributes

lib/coll.gi

@@ -3105,13 +3105,7 @@ InstallOtherMethod(SetSize,true,[IsObject and IsAttributeStoringRep,IsObject],
 function(obj,sz)
 local filt;
   if HasSize(obj) and Size(obj)<>sz then
-    if AssertionLevel()>2 then
-      # Make this an ordinary error (not ErrorNoReturn as suggested) to
-      # preserve all debugging options -- even use `return` to investigate
-      # what would have happened before this methods was introduced.
-      Error("size of ",obj," already set to ",Size(obj),
-        ", cannot be changed to ",sz);
-    fi;
+    CHECK_REPEATED_ATTRIBUTE_SET(obj, "Size", sz);
     return;
   fi;
   if sz=0 then filt:=IsEmpty;

lib/oper1.g

@@ -1090,3 +1090,13 @@ InstallMethod( ViewObj,
     [ IS_OBJECT ],
     0,
     PRINT_OBJ );
+
+BIND_GLOBAL( "CHECK_REPEATED_ATTRIBUTE_SET", function(obj, name, val)
+    if CurrentAssertionLevel >= 2 then
+        if not IsBound(obj!.(name)) then
+            ErrorNoReturn("Attribute ", name, " of ", obj, " is marked as assigned, but it has no value");
+        elif obj!.(name) <> val then
+            ErrorNoReturn(name, " of ", obj, " already set to ", obj!.(name), ", cannot be changed to ", val);
+        fi;
+    fi;
+end);

src/c_oper1.c

@@ -1,7 +1,7 @@
 #ifndef AVOID_PRECOMPILED
 /* C file produced by GAC */
 #include "compiled.h"
-#define FILE_CRC  "50470712"
+#define FILE_CRC  "126626972"
 
 /* global variables used in handlers */
 static GVar G_REREADING;
@@ -26,6 +26,8 @@ static GVar G_NARG__FUNC;
 static Obj  GF_NARG__FUNC;
 static GVar G_IS__OPERATION;
 static Obj  GF_IS__OPERATION;
+static GVar G_CurrentAssertionLevel;
+static Obj  GC_CurrentAssertionLevel;
 static GVar G_AINV;
 static Obj  GF_AINV;
 static GVar G_IS__INT;
@@ -174,14 +176,16 @@ static GVar G_PositionSortedOddPositions;
 static Obj  GF_PositionSortedOddPositions;
 static GVar G_CallFuncList;
 static Obj  GF_CallFuncList;
+static GVar G_ErrorNoReturn;
+static Obj  GF_ErrorNoReturn;
 
 /* record names used in handlers */
 static RNam R_MaxNrArgsMethod;
 static RNam R_CommandLineOptions;
 static RNam R_N;
 
 /* information for the functions */
-static Obj  NameFunc[19];
+static Obj  NameFunc[20];
 static Obj FileName;
 
 /* handler for function 2 */
@@ -5184,6 +5188,99 @@ static Obj  HdlrFunc17 (
  return 0;
 }
 
+/* handler for function 19 */
+static Obj  HdlrFunc19 (
+ Obj  self,
+ Obj  a_obj,
+ Obj  a_name,
+ Obj  a_val )
+{
+ Obj t_1 = 0;
+ Obj t_2 = 0;
+ Obj t_3 = 0;
+ Obj t_4 = 0;
+ Bag oldFrame;
+
+ /* allocate new stack frame */
+ SWITCH_TO_NEW_FRAME(self,0,0,oldFrame);
+
+ /* if CurrentAssertionLevel >= 2 then */
+ t_2 = GC_CurrentAssertionLevel;
+ CHECK_BOUND( t_2, "CurrentAssertionLevel" );
+ t_1 = (Obj)(UInt)(! LT( t_2, INTOBJ_INT(2) ));
+ if ( t_1 ) {
+
+  /* if not IsBound( obj!.(name) ) then */
+  t_3 = IsbComObj( a_obj, RNamObj(a_name) ) ? True : False;
+  t_2 = (Obj)(UInt)(t_3 != False);
+  t_1 = (Obj)(UInt)( ! ((Int)t_2) );
+  if ( t_1 ) {
+
+   /* ErrorNoReturn( "Attribute ", name, " of ", obj, " is marked as assigned, but it has no value" ); */
+   t_1 = GF_ErrorNoReturn;
+   t_2 = MakeString( "Attribute " );
+   t_3 = MakeString( " of " );
+   t_4 = MakeString( " is marked as assigned, but it has no value" );
+   if ( TNUM_OBJ( t_1 ) == T_FUNCTION ) {
+    CALL_5ARGS( t_1, t_2, a_name, t_3, a_obj, t_4 );
+   }
+   else {
+    DoOperation2Args( CallFuncListOper, t_1, NewPlistFromArgs( t_2, a_name, t_3, a_obj, t_4 ) );
+   }
+
+  }
+
+  /* elif obj!.(name) <> val then */
+  else {
+   t_2 = ElmComObj( a_obj, RNamObj(a_name) );
+   t_1 = (Obj)(UInt)( ! EQ( t_2, a_val ));
+   if ( t_1 ) {
+
+    /* ErrorNoReturn( name, " of ", obj, " already set to ", obj!.(name), ", cannot be changed to ", val ); */
+    t_1 = GF_ErrorNoReturn;
+    t_2 = NEW_PLIST( T_PLIST, 7 );
+    SET_LEN_PLIST( t_2, 7 );
+    SET_ELM_PLIST( t_2, 1, a_name );
+    CHANGED_BAG( t_2 );
+    t_3 = MakeString( " of " );
+    SET_ELM_PLIST( t_2, 2, t_3 );
+    CHANGED_BAG( t_2 );
+    SET_ELM_PLIST( t_2, 3, a_obj );
+    CHANGED_BAG( t_2 );
+    t_3 = MakeString( " already set to " );
+    SET_ELM_PLIST( t_2, 4, t_3 );
+    CHANGED_BAG( t_2 );
+    t_3 = ElmComObj( a_obj, RNamObj(a_name) );
+    SET_ELM_PLIST( t_2, 5, t_3 );
+    CHANGED_BAG( t_2 );
+    t_3 = MakeString( ", cannot be changed to " );
+    SET_ELM_PLIST( t_2, 6, t_3 );
+    CHANGED_BAG( t_2 );
+    SET_ELM_PLIST( t_2, 7, a_val );
+    CHANGED_BAG( t_2 );
+    if ( TNUM_OBJ( t_1 ) == T_FUNCTION ) {
+     CALL_XARGS( t_1, t_2 );
+    }
+    else {
+     DoOperation2Args( CallFuncListOper, t_1, t_2 );
+    }
+
+   }
+  }
+  /* fi */
+
+ }
+ /* fi */
+
+ /* return; */
+ SWITCH_TO_OLD_FRAME(oldFrame);
+ return 0;
+
+ /* return; */
+ SWITCH_TO_OLD_FRAME(oldFrame);
+ return 0;
+}
+
 /* handler for function 1 */
 static Obj  HdlrFunc1 (
  Obj  self )
@@ -5907,6 +6004,32 @@ static Obj  HdlrFunc1 (
   DoOperation2Args( CallFuncListOper, t_1, NewPlistFromArgs( t_2, t_3, t_4, t_5, INTOBJ_INT(0), t_6 ) );
  }
 
+ /* BIND_GLOBAL( "CHECK_REPEATED_ATTRIBUTE_SET", function ( obj, name, val )
+      if CurrentAssertionLevel >= 2 then
+          if not IsBound( obj!.(name) ) then
+              ErrorNoReturn( "Attribute ", name, " of ", obj, " is marked as assigned, but it has no value" );
+          elif obj!.(name) <> val then
+              ErrorNoReturn( name, " of ", obj, " already set to ", obj!.(name), ", cannot be changed to ", val );
+          fi;
+      fi;
+      return;
+  end ); */
+ t_1 = GF_BIND__GLOBAL;
+ t_2 = MakeString( "CHECK_REPEATED_ATTRIBUTE_SET" );
+ t_3 = NewFunction( NameFunc[19], 3, ArgStringToList("obj,name,val"), HdlrFunc19 );
+ SET_ENVI_FUNC( t_3, STATE(CurrLVars) );
+ t_4 = NewFunctionBody();
+ SET_STARTLINE_BODY(t_4, 1094);
+ SET_ENDLINE_BODY(t_4, 1102);
+ SET_FILENAME_BODY(t_4, FileName);
+ SET_BODY_FUNC(t_3, t_4);
+ if ( TNUM_OBJ( t_1 ) == T_FUNCTION ) {
+  CALL_2ARGS( t_1, t_2, t_3 );
+ }
+ else {
+  DoOperation2Args( CallFuncListOper, t_1, NewPlistFromArgs( t_2, t_3 ) );
+ }
+
  /* return; */
  SWITCH_TO_OLD_FRAME(oldFrame);
  return 0;
@@ -5932,6 +6055,7 @@ static Int PostRestore ( StructInitInfo * module )
  G_SET__NAME__FUNC = GVarName( "SET_NAME_FUNC" );
  G_NARG__FUNC = GVarName( "NARG_FUNC" );
  G_IS__OPERATION = GVarName( "IS_OPERATION" );
+ G_CurrentAssertionLevel = GVarName( "CurrentAssertionLevel" );
  G_AINV = GVarName( "AINV" );
  G_IS__INT = GVarName( "IS_INT" );
  G_IS__LIST = GVarName( "IS_LIST" );
@@ -6006,6 +6130,7 @@ static Int PostRestore ( StructInitInfo * module )
  G_InstallMethod = GVarName( "InstallMethod" );
  G_PositionSortedOddPositions = GVarName( "PositionSortedOddPositions" );
  G_CallFuncList = GVarName( "CallFuncList" );
+ G_ErrorNoReturn = GVarName( "ErrorNoReturn" );
 
  /* record names used in handlers */
  R_MaxNrArgsMethod = RNamName( "MaxNrArgsMethod" );
@@ -6031,6 +6156,7 @@ static Int PostRestore ( StructInitInfo * module )
  NameFunc[16] = 0;
  NameFunc[17] = 0;
  NameFunc[18] = 0;
+ NameFunc[19] = 0;
 
  /* return success */
  return 0;
@@ -6054,6 +6180,7 @@ static Int InitKernel ( StructInitInfo * module )
  InitFopyGVar( "SET_NAME_FUNC", &GF_SET__NAME__FUNC );
  InitFopyGVar( "NARG_FUNC", &GF_NARG__FUNC );
  InitFopyGVar( "IS_OPERATION", &GF_IS__OPERATION );
+ InitCopyGVar( "CurrentAssertionLevel", &GC_CurrentAssertionLevel );
  InitFopyGVar( "AINV", &GF_AINV );
  InitFopyGVar( "IS_INT", &GF_IS__INT );
  InitFopyGVar( "IS_LIST", &GF_IS__LIST );
@@ -6128,6 +6255,7 @@ static Int InitKernel ( StructInitInfo * module )
  InitFopyGVar( "InstallMethod", &GF_InstallMethod );
  InitFopyGVar( "PositionSortedOddPositions", &GF_PositionSortedOddPositions );
  InitFopyGVar( "CallFuncList", &GF_CallFuncList );
+ InitFopyGVar( "ErrorNoReturn", &GF_ErrorNoReturn );
 
  /* information for the functions */
  InitGlobalBag( &FileName, "GAPROOT/lib/oper1.g:FileName("FILE_CRC")" );
@@ -6167,6 +6295,8 @@ static Int InitKernel ( StructInitInfo * module )
  InitGlobalBag( &(NameFunc[17]), "GAPROOT/lib/oper1.g:NameFunc[17]("FILE_CRC")" );
  InitHandlerFunc( HdlrFunc18, "GAPROOT/lib/oper1.g:HdlrFunc18("FILE_CRC")" );
  InitGlobalBag( &(NameFunc[18]), "GAPROOT/lib/oper1.g:NameFunc[18]("FILE_CRC")" );
+ InitHandlerFunc( HdlrFunc19, "GAPROOT/lib/oper1.g:HdlrFunc19("FILE_CRC")" );
+ InitGlobalBag( &(NameFunc[19]), "GAPROOT/lib/oper1.g:NameFunc[19]("FILE_CRC")" );
 
  /* return success */
  return 0;
@@ -6201,7 +6331,7 @@ static Int InitLibrary ( StructInitInfo * module )
 static StructInitInfo module = {
  .type        = MODULE_STATIC,
  .name        = "GAPROOT/lib/oper1.g",
- .crc         = 50470712,
+ .crc         = 126626972,
  .initKernel  = InitKernel,
  .initLibrary = InitLibrary,
  .postRestore = PostRestore,

src/opers.c

@@ -1453,6 +1453,7 @@ static UInt RNamIsVerbose;
 static UInt RNamIsConstructor;
 static UInt RNamPrecedence;
 static Obj  HANDLE_METHOD_NOT_FOUND;
+static Obj  CHECK_REPEATED_ATTRIBUTE_SET;
 
 static void HandleMethodNotFound(Obj   oper,
                                  Int   nargs,
@@ -3389,12 +3390,15 @@ static Obj DoSetterFunction(Obj self, Obj obj, Obj value)
     flag2  = INT_INTOBJ( FLAG2_FILT(tester) );
     type   = TYPE_OBJ_FEO(obj);
     flags  = FLAGS_TYPE(type);
+
+    UInt rnam = (UInt)INT_INTOBJ(ELM_PLIST(tmp,1));
+
     if ( SAFE_C_ELM_FLAGS(flags,flag2) ) {
+        CALL_3ARGS(CHECK_REPEATED_ATTRIBUTE_SET, obj, NAME_RNAM(rnam), value);
         return 0;
     }
 
     /* set the value                                                       */
-    UInt rnam = (UInt)INT_INTOBJ(ELM_PLIST(tmp,1));
 #ifdef HPCGAP
     if (atomic)
       SetARecordField( obj, rnam, CopyObj(value,0) );
@@ -3856,6 +3860,7 @@ static Int InitKernel (
     ImportGVarFromLibrary( "TYPE_FLAGS", &TYPE_FLAGS );
     TypeObjFuncs[ T_FLAGS ] = TypeFlags;
 
+
 
     /* set up hidden implications                                          */
     InitGlobalBag( &WITH_HIDDEN_IMPS_FLAGS_CACHE, "src/opers.c:WITH_HIDDEN_IMPS_FLAGS_CACHE");
@@ -3883,6 +3888,9 @@ static Int InitKernel (
     ImportFuncFromLibrary("HANDLE_METHOD_NOT_FOUND",
                           &HANDLE_METHOD_NOT_FOUND);
 
+    ImportFuncFromLibrary("CHECK_REPEATED_ATTRIBUTE_SET",
+                          &CHECK_REPEATED_ATTRIBUTE_SET);
+
 #ifdef GASMAN
     ImportGVarFromLibrary( "IsType", &IsType );
     ImportFuncFromLibrary( "FLUSH_ALL_METHOD_CACHES", &FLUSH_ALL_METHOD_CACHES );

tst/testinstall/attribute.tst

@@ -60,6 +60,10 @@ gap> HasSize(foo);
 true
 gap> Size(foo);
 17
+gap> SetSize(foo, 16);
+Error, Size of <object> already set to 17, cannot be changed to 16
+gap> Size(foo);
+17
 gap> InstallMethod(FavouriteFruit, [HasSize], x-> "pear");
 gap> FavouriteFruit(foo);
 "pear"
@@ -70,5 +74,10 @@ gap> FavouriteFruit(foo);
 "pear"
 gap> HasFavouriteFruit(foo);
 true
+gap> SetFavouriteFruit(foo, "apple");
+Error, FavouriteFruit of <object> already set to pear, cannot be changed to ap\
+ple
+gap> FavouriteFruit(foo);
+"pear"
 #@fi
 gap> STOP_TEST("attribute.tst", 1);