[Committed] PR fortran/54072 -- More fun with BOZ

[Steve Kargl <sgk at troutmask dot apl dot washington dot edu>]

I've committed the attached patch as a follow-up to
the recent BOZ (r273747).  It removes a few leftover
comments as well as fixes the PR.

2019-07-23  Steven G. Kargl  <kargl@gcc.gnu.org>

 PR fortran/54072
 * check.c (gfc_invalid_boz): Fix comment.
 (illegal_boz_arg): New function.
 (gfc_check_transfer): Use to arguments.
 (gfc_check_storage_size): Ditto.
 (gfc_check_complex): Remove leftover comment from BOZ patch.
 * primary.c (match_boz_constant): Remove leftover comment. 


2019-07-23  Steven G. Kargl  <kargl@gcc.gnu.org>

 PR fortran/54072
 * gfortran.dg/illegal_boz_arg_1.f90: New tests.

-- 
Steve

Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(revision 273747)
+++ gcc/fortran/check.c	(working copy)
@@ -35,10 +35,10 @@ along with GCC; see the file COPYING3.  If not see
 #include "target-memory.h"
 
 /* A BOZ literal constant can appear in a limited number of contexts.
-   gfc_invalid_boz() is a help function to simplify error/warning generation.
-   Note, gfortran accepts the nonstandard 'X' for 'Z' the nonstandard
-   suffix location.  If -fallow-invalid-boz is used, then issue a warning;
-   otherwise issue an error.  */
+   gfc_invalid_boz() is a helper function to simplify error/warning
+   generation.  gfortran accepts the nonstandard 'X' for 'Z', and gfortran
+   allows the BOZ indicator to appear as a suffix.  If -fallow-invalid-boz
+   is used, then issue a warning; otherwise issue an error.  */
 
 bool
 gfc_invalid_boz (const char *msg, locus *loc)
@@ -54,6 +54,20 @@ gfc_invalid_boz (const char *msg, locus *loc)
 }
 
 
+/* Issue an error for an illegal BOZ argument.  */
+static bool
+illegal_boz_arg (gfc_expr *x)
+{
+  if (x->ts.type == BT_BOZ)
+    {
+      gfc_error ("BOZ literal constant at %L cannot be an actual argument "
+		 "to %qs", &x->where, gfc_current_intrinsic);
+      return true;
+    }
+
+  return false;
+}
+
 /* Some precedures take two arguments such that both cannot be BOZ.  */
 
 static bool
@@ -2202,8 +2216,6 @@ gfc_check_co_sum (gfc_expr *a, gfc_expr *result_image,
 bool
 gfc_check_complex (gfc_expr *x, gfc_expr *y)
 {
-
-  /* FIXME BOZ.  What to do with complex?  */
   if (!boz_args_check (x, y))
     return false;
 
@@ -5894,6 +5906,12 @@ gfc_check_transfer (gfc_expr *source, gfc_expr *mold, 
       return false;
     }
 
+  if (source->ts.type == BT_BOZ && illegal_boz_arg (source))
+    return false;
+
+  if (mold->ts.type == BT_BOZ && illegal_boz_arg (mold))
+    return false;
+
   /* MOLD shall be a scalar or array of any type.  */
   if (mold->ts.type == BT_PROCEDURE
       && mold->symtree->n.sym->attr.subroutine == 1)
@@ -7124,6 +7142,9 @@ gfc_check_storage_size (gfc_expr *a, gfc_expr *kind)
 		 gfc_current_intrinsic, &a->where);
       return false;
     }
+
+  if (a->ts.type == BT_BOZ && illegal_boz_arg (a))
+    return false;
 
   if (kind == NULL)
     return true;
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 273747)
+++ gcc/fortran/primary.c	(working copy)
@@ -494,7 +494,6 @@ match_boz_constant (gfc_expr **result)
   e->boz.str = XCNEWVEC (char, length + 1);
   strncpy (e->boz.str, buffer, length);
 
-  /* FIXME BOZ.  */
   if (!gfc_in_match_data ()
       && (!gfc_notify_std(GFC_STD_F2003, "BOZ used outside a DATA "
 			  "statement at %L", &e->where)))
Index: gcc/testsuite/gfortran.dg/illegal_boz_arg_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/illegal_boz_arg_1.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/illegal_boz_arg_1.f90	(working copy)
@@ -0,0 +1,9 @@
+! { dg-do compile }
+program foo
+   implicit none
+   integer :: i = 42
+   print *, storage_size(z'1234')     ! { dg-error "cannot be an actual" }
+   print *, transfer(z'1234', i)      ! { dg-error "cannot be an actual" }
+   print *, transfer(i, z'1234')      ! { dg-error "cannot be an actual" }
+   print *, transfer(i, i, z'1234')   ! { dg-error "must be INTEGER" }
+end program foo