re PR fortran/39997 (Procedure(), pointer & implicit typing: rejects-valid / accepts-invalid?)

2010-04-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/39997
        * intrinsic.c (add_functions): Add num_images.
        * decl.c (gfc_match_end): Handle END CRITICAL.
        * intrinsic.h (gfc_simplify_num_images): Add prototype.
        * dump-parse-tree.c (show_code_node): Dump CRITICAL, ERROR STOP,
        and SYNC.
        * gfortran.h (gfc_statement): Add enum items for those.
        (gfc_exec_op) Ditto.
        (gfc_isym_id): Add num_images.
        * trans-stmt.c (gfc_trans_stop): Handle ERROR STOP.
        (gfc_trans_sync,gfc_trans_critical): New functions.
        * trans-stmt.h (gfc_trans_stop,gfc_trans_sync,
        gfc_trans_critical): Add/update prototypes.
        * trans.c (gfc_trans_code): Handle CRITICAL, ERROR STOP,
        and SYNC statements.
        * trans.h (gfor_fndecl_error_stop_string) Add variable.
        * resolve.c (resolve_sync): Add function.
        (gfc_resolve_blocks): Handle CRITICAL.
        (resolve_code): Handle CRITICAL, ERROR STOP,
        (resolve_branch): Add CRITICAL constraint check.
        and SYNC statements.
        * st.c (gfc_free_statement): Add new statements.
        * trans-decl.c (gfor_fndecl_error_stop_string): Global variable.
        (gfc_build_builtin_function_decls): Initialize it.
        * match.c (gfc_match_if): Handle ERROR STOP and SYNC.
        (gfc_match_critical, gfc_match_error_stop, sync_statement,
        gfc_match_sync_all, gfc_match_sync_images,
gfc_match_sync_memory):
        New functions.
        (match_exit_cycle): Handle CRITICAL constraint.
        (gfc_match_stopcode): Handle ERROR STOP.
        * match.h (gfc_match_critical, gfc_match_error_stop,
        gfc_match_sync_all, gfc_match_sync_images,
        gfc_match_sync_memory): Add prototype.
        * parse.c (decode_statement, gfc_ascii_statement,
        parse_executable): Handle new statements.
        (parse_critical_block): New function.
        * parse.h (gfc_compile_state): Add COMP_CRITICAL.
        * intrinsic.texi (num_images): Document new function.
        * simplify.c (gfc_simplify_num_images): Add function.

2010-04-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/39997
        * gfortran.dg/coarray_1.f90: New test.
        * gfortran.dg/coarray_2.f90: New test.
        * gfortran.dg/coarray_3.f90: New test.

2010-04-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/39997
        * runtime/stop.c (error_stop_string): New function.
        * gfortran.map (_gfortran_error_stop_string): Add.

From-SVN: r158008

1 files changed, 58 insertions, 1 deletions

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index f363816..6c67e7d 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1,5 +1,5 @@
 /* Parse tree dumper
-   Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009
+   Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
    Free Software Foundation, Inc.
    Contributed by Steven Bosscher
 
@@ -1273,6 +1273,10 @@ show_code_node (int level, gfc_code *c)
 
       break;
 
+    case EXEC_ERROR_STOP:
+      fputs ("ERROR ", dumpfile);
+      /* Fall through.  */
+
     case EXEC_STOP:
       fputs ("STOP ", dumpfile);
 
@@ -1283,6 +1287,52 @@ show_code_node (int level, gfc_code *c)
 
       break;
 
+    case EXEC_SYNC_ALL:
+      fputs ("SYNC ALL ", dumpfile);
+      if (c->expr2 != NULL)
+	{
+	  fputs (" stat=", dumpfile);
+	  show_expr (c->expr2);
+	}
+      if (c->expr3 != NULL)
+	{
+	  fputs (" errmsg=", dumpfile);
+	  show_expr (c->expr3);
+	}
+      break;
+
+    case EXEC_SYNC_MEMORY:
+      fputs ("SYNC MEMORY ", dumpfile);
+      if (c->expr2 != NULL)
+ 	{
+	  fputs (" stat=", dumpfile);
+	  show_expr (c->expr2);
+	}
+      if (c->expr3 != NULL)
+	{
+	  fputs (" errmsg=", dumpfile);
+	  show_expr (c->expr3);
+	}
+      break;
+
+    case EXEC_SYNC_IMAGES:
+      fputs ("SYNC IMAGES  image-set=", dumpfile);
+      if (c->expr1 != NULL)
+	show_expr (c->expr1);
+      else
+	fputs ("* ", dumpfile);
+      if (c->expr2 != NULL)
+	{
+	  fputs (" stat=", dumpfile);
+	  show_expr (c->expr2);
+	}
+      if (c->expr3 != NULL)
+	{
+	  fputs (" errmsg=", dumpfile);
+	  show_expr (c->expr3);
+	}
+      break;
+
     case EXEC_ARITHMETIC_IF:
       fputs ("IF ", dumpfile);
       show_expr (c->expr1);
@@ -1400,6 +1450,13 @@ show_code_node (int level, gfc_code *c)
       fputs ("END FORALL", dumpfile);
       break;
 
+    case EXEC_CRITICAL:
+      fputs ("CRITICAL\n", dumpfile);
+      show_code (level + 1, c->block->next);
+      code_indent (level, 0);
+      fputs ("END CRITICAL", dumpfile);
+      break;
+
     case EXEC_DO:
       fputs ("DO ", dumpfile);