Fixes for runtime errors in GenASis App

tools/flang1/flang1exe/lowerilm.c

@@ -3700,7 +3700,10 @@ lower_stmt(int std, int ast, int lineno, int label)
         }
       }
       lower_reinit();
-      add_nullify(object);
+      // AOCC change
+      if ((A_MEM_ORDERG(A_SRCG(ast)) != A_SRCG(ast)) ) {
+         add_nullify(object);
+      }
     }
     lower_end_stmt(std);
     break;

tools/flang1/flang1exe/semant2.c

@@ -1488,6 +1488,11 @@ semant2(int rednum, SST *top)
       break;
     }
     i = NMPTRG(SST_SYMG(RHS(rhstop)));
+    //AOCC Begin
+    if (STYPEG(SST_SYMG(RHS(rhstop))) == ST_USERGENERIC ||
+        STYPEG(SST_SYMG(RHS(rhstop))) == ST_PROC)
+        A_ALIASP(ast,SST_SYMG(RHS(rhstop)));
+    //AOCC End
     ast = mkmember(dtype, ast, i);
     if (ast) {
       sptr1 = A_SPTRG(A_MEMG(ast));

tools/flang1/flang1exe/semutil.c

@@ -6908,9 +6908,22 @@ mkmember(int structd, int base, int nmx)
       if (flg.xref)
         xrefput(sptr, 'r');
       member = mk_id(sptr);
+      A_ALIASP(base,0);
       ast = mk_member(base, mk_id(sptr), dtype);
       return ast;
-    } else if (PARENTG(sptr)) { /* type extension */
+    //AOCC Begin
+    } else if ((STYPEG(BINDG(sptr)) == ST_USERGENERIC) &&
+        (STYPEG(A_ALIASG(base)) == ST_USERGENERIC ||
+        STYPEG(A_ALIASG(base)) == ST_PROC)){
+      char* var = SYMNAME(A_ALIASG(base));
+      if(!strncmp(SYMNAME(sptr),var,strlen(var))){
+        A_ALIASP(base,0);
+        int ast = mk_member(base, mk_id(BINDG(sptr)), dtype);
+        return ast;
+      }
+    }
+    //AOCC End
+    else if (PARENTG(sptr)) { /* type extension */
       int ast = mkmember(DTYPEG(sptr), base, nmx);
       if (ast)
         return ast;
@@ -7160,4 +7173,3 @@ error83(int ty)
   else
     errsev(83);
 }
-

tools/flang1/flang1exe/transfrm.c

@@ -3692,7 +3692,24 @@ rewrite_deallocate(int ast, bool is_assign_lhs, int std)
       astparent = mk_subscr_copy(ast, asd, DTY(dtype + 1));
     }
   }
-
+  // AOCC Begin
+  bool reorder_nullify=false;
+  for (sptrmem = DTY(DDTG(dtype) + 1); sptrmem > NOSYM;
+       sptrmem = SYMLKG(sptrmem)) {
+    if (is_tbp_or_final(sptrmem)) {
+      continue; /* skip tbp */
+    }
+    if (!ALLOCATTRG(sptrmem)) {
+      continue;
+    }
+    if (has_finalized_component(sptrmem))
+      reorder_nullify=true;
+  }
+  if (reorder_nullify) {
+    add_stmt_after(add_nullify_ast(ast), std);
+    A_MEM_ORDERP(ast,ast);
+  }
+  // AOCC End
   for (sptrmem = DTY(DDTG(dtype) + 1); sptrmem > NOSYM;
        sptrmem = SYMLKG(sptrmem)) {
     int astdealloc;
@@ -3710,9 +3727,12 @@ rewrite_deallocate(int ast, bool is_assign_lhs, int std)
     }
     astdealloc = mk_deallocate(astmem);
     A_DALLOCMEMP(astdealloc, 1);
-    add_stmt_before(astdealloc, std);
+    if (reorder_nullify) {  // AOCC
+      add_stmt_after(astdealloc, std);
+    } else {
+      add_stmt_before(astdealloc, std);
+    }
   }
-
   gen_do_ends(docnt, std);
   if (need_endif) {
     int astendif = mk_stmt(A_ENDIF, 0);

tools/flang2/flang2exe/llassem.cpp

@@ -2150,7 +2150,7 @@ write_parent_pointers(int parent, int level)
 /* final table size is max dimensions plus 2. The 0th element holds the
  * scalar subroutine and the last element holds the elemental subroutine.
  */
-#define FINAL_TABLE_SZ 9
+#define FINAL_TABLE_SZ MAXSUBS + 2
 
 static int
 build_final_table(DTYPE dtype, SPTR ft[FINAL_TABLE_SZ])
@@ -2275,7 +2275,7 @@ has_pending_final_procedures(SPTR sptr)
   dtype = DTyArgType(dtype);
 
   for (mem = DTyAlgTyMember(dtype); mem > NOSYM; mem = SYMLKG(mem)) {
-    if (CLASSG(mem) && FINALG(mem) < 0)
+    if (CLASSG(mem) && FINALG(mem))  // AOCC : Changed from (FINALG(mem) < 0)
       return 1;
   }
   return 0;