This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[gfortran] Add -std=


Attached patch adds -std= option to gfortran.

Hopefully it should be flexible enough to support whatever options and 
defaults we decide we want.

Tested on i686-linux.
Applied to tree-ssa branch.

Paul

2004-01-04  Paul Brook  <paul@codesourcery.com>

	* error.c (gfc_notify_std): New function.
	* gfortran.h (gfc_notify_std): Declare.
	(GFC_STD_*): Define.
	(gfc_option_t): Add warn_std and allow_std.
	* intrinsic.c (gfc_init_expr_extensions): Fix logic.
	(gfc_intrinsic_func_interface): Use gfc_notify_std.
	* check.c (check_rest): Use gfc_notify_std.
	* match.c (gfc_match_pause): Ditto.
	(gfc_match_assign): Ditto.
	(gfc_match_goto): Ditto.
	* resolve.c (resolve_branch): Ditto.
	* lang.opt: Add std=<foo> and w.
	* options.c (gfc_init_options): Set allow_std and warn_std.
	(gfc_handle_option): Handle OPT_std_*
? gcc/testsuite/gfortran.fortran-torture/execute/assign.f90
Index: gcc/fortran/check.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/check.c,v
retrieving revision 1.1.2.4
diff -u -p -r1.1.2.4 check.c
--- gcc/fortran/check.c	11 Oct 2003 23:00:22 -0000	1.1.2.4
+++ gcc/fortran/check.c	4 Jan 2004 12:22:29 -0000
@@ -978,11 +978,12 @@ check_rest (bt type, int kind, gfc_actua
       x = arg->expr;
       if (x->ts.type != type || x->ts.kind != kind)
 	{
-          if (x->ts.type == type && !pedantic)
+          if (x->ts.type == type)
             {
-              /* Allow different kinds as an extension.  */
-              gfc_warning ("Different kind types at %L is an extension",
-                           &x->where);
+	      if (gfc_notify_std (GFC_STD_GNU,
+		    "Extension: Different type kinds at %L", &x->where)
+		  == FAILURE)
+		return FAILURE;
             }
           else
             {
Index: gcc/fortran/error.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/error.c,v
retrieving revision 1.1.2.1
diff -u -p -r1.1.2.1 error.c
--- gcc/fortran/error.c	26 Jul 2003 16:27:45 -0000	1.1.2.1
+++ gcc/fortran/error.c	4 Jan 2004 12:22:29 -0000
@@ -467,6 +467,58 @@ gfc_warning (const char *format, ...)
 }
 
 
+/* Possibly issue a warning/error about use of a nonstandard (or deleted)
+   feature.  An error/warning will be issued if the currently selected
+   standard does not contain the requested bits.  Return FAILURE if
+   and error is generated.  */
+
+try
+gfc_notify_std (int std, const char *format, ...)
+{
+  va_list argp;
+  bool warning;
+
+  warning = ((gfc_option.warn_std & std) != 0)
+	    && !inhibit_warnings;
+  if ((gfc_option.allow_std & std) != 0
+      && !warning)
+    return SUCCESS;
+
+  if (gfc_suppress_error)
+    return warning ? SUCCESS : FAILURE;
+  
+  if (warning)
+    {
+      warning_buffer.flag = 1;
+      warning_ptr = warning_buffer.message;
+      use_warning_buffer = 1;
+    }
+  else
+    {
+      error_buffer.flag = 1;
+      error_ptr = error_buffer.message;
+      use_warning_buffer = 0;
+    }
+
+  if (buffer_flag == 0)
+    {
+      if (warning)
+	warnings++;
+      else
+	errors++;
+    }
+  va_start (argp, format);
+  if (warning)
+    error_print ("Warning:", format, argp);
+  else
+    error_print ("Error:", format, argp);
+  va_end (argp);
+
+  error_char ('\0');
+  return warning ? SUCCESS : FAILURE;
+}
+
+
 /* Immediate warning (i.e. do not buffer the warning).  */
 
 void
Index: gcc/fortran/gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/gfortran.h,v
retrieving revision 1.1.2.8
diff -u -p -r1.1.2.8 gfortran.h
--- gcc/fortran/gfortran.h	1 Jan 2004 22:22:30 -0000	1.1.2.8
+++ gcc/fortran/gfortran.h	4 Jan 2004 12:22:30 -0000
@@ -96,6 +96,14 @@ typedef struct
 mstring;
 
 
+/* Flags to specify which standardi/extension contains a feature.  */
+#define GFC_STD_GNU		(1<<5)	/* GNU Fortran extension.  */
+#define GFC_STD_F2003		(1<<4)	/* New in F2003.  */
+#define GFC_STD_F2003_DEL	(1<<3)	/* Deleted in F2003.  */
+#define GFC_STD_F2003_OBS	(1<<2)	/* Obsoleted in F2003.  */
+#define GFC_STD_F95_DEL		(1<<1)	/* Deleted in F95.  */
+#define GFC_STD_F95_OBS		(1<<0)	/* Obsoleted in F95.  */
+
 /*************************** Enums *****************************/
 
 /* The author remains confused to this day about the convention of
@@ -1228,6 +1236,8 @@ typedef struct
   int r8;
   int i8;
   int d8;
+  int warn_std;
+  int allow_std;
 }
 gfc_option_t;
 
@@ -1353,6 +1363,8 @@ void gfc_fatal_error (const char *, ...)
 void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN;
 void gfc_clear_error (void);
 int gfc_error_check (void);
+
+try gfc_notify_std (int, const char *, ...);
 
 /* A general purpose syntax error.  */
 #define gfc_syntax_error(ST)	\
Index: gcc/fortran/intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/intrinsic.c,v
retrieving revision 1.1.2.7
diff -u -p -r1.1.2.7 intrinsic.c
--- gcc/fortran/intrinsic.c	1 Jan 2004 12:09:12 -0000	1.1.2.7
+++ gcc/fortran/intrinsic.c	4 Jan 2004 12:22:31 -0000
@@ -2276,9 +2276,9 @@ gfc_init_expr_extensions (gfc_intrinsic_
 
   for (i = 0; init_expr_extensions[i]; i++)
     if (strcmp (init_expr_extensions[i], isym->name) == 0)
-      return 1;
+      return 0;
 
-  return 0;
+  return 1;
 }
 
 
@@ -2376,15 +2376,21 @@ got_specific:
       return MATCH_ERROR;
     }
 
+  /* TODO: We should probably only allow elemental functions here.  */
   flag |= (expr->ts.type != BT_INTEGER && expr->ts.type != BT_CHARACTER);
 
+  gfc_suppress_error = 0;
   if (pedantic && gfc_init_expr
       && flag && gfc_init_expr_extensions (specific))
-    gfc_warning
-      ("Evaluation of initialization expression at %L is nonstandard",
-       &expr->where);
+    {
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: Evaluation of "
+	    "nonstandard initialization expression at %L", &expr->where)
+	  == FAILURE)
+	{
+	  return MATCH_ERROR;
+	}
+    }
 
-  gfc_suppress_error = 0;
   return MATCH_YES;
 }
 
Index: gcc/fortran/lang.opt
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/lang.opt,v
retrieving revision 1.1.2.4
diff -u -p -r1.1.2.4 lang.opt
--- gcc/fortran/lang.opt	16 Oct 2003 18:04:51 -0000	1.1.2.4
+++ gcc/fortran/lang.opt	4 Jan 2004 12:22:31 -0000
@@ -137,4 +137,16 @@ r8
 F95 RejectNegative
 Set the default real kind to double precision
 
+std=f95
+F95 RejectNegative
+Conform to the ISO Fortran 95 standard.
+
+std=f2003
+F95 RejectNegative
+Conform to the ISO Fortran 2003 standard.
+
+std=gnu
+F95 RejectNegative
+Conform nothing in particular.
+
 ; This comment is to ensure we retain the blank line above.
Index: gcc/fortran/match.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/match.c,v
retrieving revision 1.1.2.6
diff -u -p -r1.1.2.6 match.c
--- gcc/fortran/match.c	1 Jan 2004 12:42:51 -0000	1.1.2.6
+++ gcc/fortran/match.c	4 Jan 2004 12:22:32 -0000
@@ -1426,13 +1426,10 @@ gfc_match_pause (void)
   m = gfc_match_stopcode (ST_PAUSE);
   if (m == MATCH_YES)
     {
-      if (pedantic)
-	{
-	  gfc_error ("The PAUSE statement at %C is not allowed in Fortran 95");
-	  return MATCH_ERROR;
-	}
-      else
-	gfc_warning ("Use of the PAUSE statement at %C is deprecated");
+      if (gfc_notify_std (GFC_STD_F95_DEL,
+	    "Obsolete: PAUSE statement at %C")
+	  == FAILURE)
+	m = MATCH_ERROR;
     }
   return m;
 }
@@ -1478,6 +1475,11 @@ gfc_match_assign (void)
         return MATCH_ERROR;
       if (gfc_match (" to %v%t", &expr) == MATCH_YES)
         {
+	  if (gfc_notify_std (GFC_STD_F95_DEL,
+		"Obsolete: ASSIGN statement at %C")
+	      == FAILURE)
+	    return MATCH_ERROR;
+
           expr->symtree->n.sym->attr.assign = 1;
 
           new_st.op = EXEC_LABEL_ASSIGN;
@@ -1519,53 +1521,60 @@ gfc_match_goto (void)
 
   if (gfc_match_variable (&expr, 0) == MATCH_YES)
     {
+      if (gfc_notify_std (GFC_STD_F95_DEL,
+			  "Obsolete: Assigned GOTO statement at %C")
+	  == FAILURE)
+	return MATCH_ERROR;
+
       expr->symtree->n.sym->attr.assign = 1;
       new_st.op = EXEC_GOTO;
       new_st.expr = expr;
 
       if (gfc_match_eos () == MATCH_YES)
-        return MATCH_YES;
+	return MATCH_YES;
 
       /* Match label list.  */
       gfc_match_char (',');
       if (gfc_match_char ('(') != MATCH_YES)
-        {
-          gfc_syntax_error (ST_GOTO);
-          return MATCH_ERROR;
-        }
+	{
+	  gfc_syntax_error (ST_GOTO);
+	  return MATCH_ERROR;
+	}
       head = tail = NULL;
 
       do
-        {
-          m = gfc_match_st_label (&label, 0);
-          if (m != MATCH_YES)
-            goto syntax;
-
-          if (gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
-            goto cleanup;
-
-          if (head == NULL)
-            head = tail = gfc_get_code ();
-          else
+	{
+	  m = gfc_match_st_label (&label, 0);
+	  if (m != MATCH_YES)
+	    goto syntax;
+
+	  if (gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
+	    goto cleanup;
+
+	  if (head == NULL)
+	    head = tail = gfc_get_code ();
+	  else
 	    {
-              tail->block = gfc_get_code ();
-              tail = tail->block;
-            }
+	      tail->block = gfc_get_code ();
+	      tail = tail->block;
+	    }
 
-          tail->label = label;
-          tail->op = EXEC_GOTO;
-        }
+	  tail->label = label;
+	  tail->op = EXEC_GOTO;
+	}
       while (gfc_match_char (',') == MATCH_YES);
 
       if (gfc_match (")%t") != MATCH_YES)
-        goto syntax;
+	goto syntax;
 
       if (head == NULL)
-        {
-           gfc_error ("Statement label list in GOTO at %C cannot be empty");
-           goto syntax;
-        }
+	{
+	   gfc_error (
+	       "Statement label list in GOTO at %C cannot be empty");
+	   goto syntax;
+	}
       new_st.block = head;
+
       return MATCH_YES;
     }
 
Index: gcc/fortran/options.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/options.c,v
retrieving revision 1.1.2.8
diff -u -p -r1.1.2.8 options.c
--- gcc/fortran/options.c	22 Dec 2003 22:50:17 -0000	1.1.2.8
+++ gcc/fortran/options.c	4 Jan 2004 12:22:32 -0000
@@ -75,6 +75,11 @@ gfc_init_options (unsigned int argc ATTR
 
   flag_argument_noalias = 2;
 
+  gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
+    | GFC_STD_F2003_OBS | GFC_STD_F2003_DEL | GFC_STD_F2003 | GFC_STD_GNU;
+  gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
+    | GFC_STD_F2003 | GFC_STD_GNU;
+
   return CL_F95;
 }
 
@@ -286,6 +291,25 @@ gfc_handle_option (size_t scode, const c
     case OPT_J:
     case OPT_M:
       gfc_handle_module_path_options (arg);
+    
+    case OPT_std_f95:
+      gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F2003_OBS
+	| GFC_STD_F2003_DEL;
+      gfc_option.warn_std = GFC_STD_F95_OBS;
+      break;
+
+    case OPT_std_f2003:
+      gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F2003_OBS
+	| GFC_STD_F2003;
+      gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2003_OBS;
+      break;
+
+    case OPT_std_gnu:
+      gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
+	| GFC_STD_F2003_OBS | GFC_STD_F2003_DEL | GFC_STD_F2003 | GFC_STD_GNU;
+      gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
+	| GFC_STD_F2003_OBS | GFC_STD_F2003_DEL | GFC_STD_GNU;
+      break;
     }
 
   return result;
Index: gcc/fortran/resolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/resolve.c,v
retrieving revision 1.1.2.14
diff -u -p -r1.1.2.14 resolve.c
--- gcc/fortran/resolve.c	1 Jan 2004 22:22:31 -0000	1.1.2.14
+++ gcc/fortran/resolve.c	4 Jan 2004 12:22:33 -0000
@@ -2939,8 +2939,9 @@ resolve_branch (gfc_st_label * label, gf
 	  break;
 
       if (stack == NULL)
-	gfc_error ("GOTO at %L cannot jump to END of construct at %L",
-		   &found->loc, &code->loc);
+	gfc_notify_std (GFC_STD_F95_DEL,
+			"Obsolete: GOTO at %L jumps to END of construct at %L",
+			&found->loc, &code->loc);
     }
 }
 

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]