public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/modula-2] Runtime errors emit errors using GCC scope heading and message style.
@ 2021-11-18 10:08 Gaius Mulley
  0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2021-11-18 10:08 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:c62f597484409ee3c33fe491dc8feb38d5345e54

commit c62f597484409ee3c33fe491dc8feb38d5345e54
Author: Gaius Mulley <gaius.mulley@southwales.ac.uk>
Date:   Thu Nov 18 10:07:14 2021 +0000

    Runtime errors emit errors using GCC scope heading and message style.
    
    2021-11-18  Gaius Mulley  <gaius.mulley@southwales.ac.uk>
    
    gcc/m2/ChangeLog:
    
            * gm2-compiler/M2Error.def (GetAnnounceScope): Exported.
            (AnnounceScope) changed to use an extra parameter message.
            * gm2-compiler/M2Error.mod (GetAnnounceScope): New procedure function.
            (AnnounceScope) Rewritten to use GetAnnounceScope.
            * gm2-compiler/M2Range.mod (M2Error): Added GetAnnounceScope to
            import list.  (CodeErrorCheckLoc) Rewritten to use GetAnnounceScope.
            * gm2-gcc/rtegraph.c (generate_report): Emit error message using
            the GCC scope heading and message house style.
            * gm2-libs/RTExceptions.mod (Raise): Emit the message using the GCC
            scope heading and message house style.
    
    Signed-off-by: Gaius Mulley <gaius.mulley@southwales.ac.uk>

Diff:
---
 gcc/m2/gm2-compiler/M2Error.def  | 15 +++++++--
 gcc/m2/gm2-compiler/M2Error.mod  | 71 ++++++++++++++++++++++++----------------
 gcc/m2/gm2-compiler/M2Range.mod  | 11 +++++--
 gcc/m2/gm2-gcc/rtegraph.c        |  4 +--
 gcc/m2/gm2-libs/RTExceptions.mod | 37 ++++++++++++---------
 5 files changed, 86 insertions(+), 52 deletions(-)

diff --git a/gcc/m2/gm2-compiler/M2Error.def b/gcc/m2/gm2-compiler/M2Error.def
index 8603fbd7680..14e54223dac 100644
--- a/gcc/m2/gm2-compiler/M2Error.def
+++ b/gcc/m2/gm2-compiler/M2Error.def
@@ -45,7 +45,7 @@ EXPORT QUALIFIED Error,
                  WarnFormat0, WarnFormat1, MoveError,
                  AnnounceScope, EnterImplementationScope,
                  EnterModuleScope, EnterDefinitionScope, EnterProgramScope,
-                 EnterProcedureScope, LeaveScope, DepthScope ;
+                 EnterProcedureScope, LeaveScope, DepthScope, GetAnnounceScope ;
 
 TYPE
    Error ;
@@ -223,11 +223,11 @@ PROCEDURE ErrorAbort0 (a: ARRAY OF CHAR) ;
 
 
 (*
-   AnnounceScope - return the error string s with a scope description prepended
+   AnnounceScope - return the error string message with a scope description prepended
                    assuming that scope has changed.
 *)
 
-PROCEDURE AnnounceScope (e: Error; s: String) : String ;
+PROCEDURE AnnounceScope (e: Error; message: String) : String ;
 
 
 (*
@@ -284,4 +284,13 @@ PROCEDURE LeaveScope ;
 PROCEDURE DepthScope () : CARDINAL ;
 
 
+(*
+   GetAnnounceScope - return message with the error scope attached to message.
+                      filename and message are treated as read only by this
+                      procedure function.
+*)
+
+PROCEDURE GetAnnounceScope (filename, message: String) : String ;
+
+
 END M2Error.
diff --git a/gcc/m2/gm2-compiler/M2Error.mod b/gcc/m2/gm2-compiler/M2Error.mod
index 9b4dfe03648..7dd6fa87869 100644
--- a/gcc/m2/gm2-compiler/M2Error.mod
+++ b/gcc/m2/gm2-compiler/M2Error.mod
@@ -808,17 +808,52 @@ END ErrorAbort0 ;
 
 
 (*
+   GetAnnounceScope - return message with the error scope attached to message.
+                      filename and message are treated as read only by this
+                      procedure function.
+*)
+
+PROCEDURE GetAnnounceScope (filename, message: String) : String ;
+VAR
+   pre,
+   fmt,
+   desc,
+   quoted: String ;
+BEGIN
+   IF filename = NIL
+   THEN
+      pre := InitString ('')
+   ELSE
+      pre := Sprintf1 (Mark (InitString ("%s: ")), filename)
+   END ;
+
+   quoted := quoteOpen (InitString ('')) ;
+   quoted := ConCat (quoted, Mark (InitStringCharStar (KeyToCharStar (scopeName)))) ;
+   quoted := quoteClose (quoted) ;
+   CASE scopeKind OF
+
+   definition    :   desc := InitString ("In definition module") |
+   implementation:   desc := InitString ("In implementation module") |
+   program       :   desc := InitString ("In program module") |
+   module        :   desc := InitString ("In inner module") |
+   procedure     :   desc := InitString ("In procedure")
+
+   END ;
+   fmt := ConCat (pre, desc) ;
+   fmt := ConCat (fmt, Sprintf1 (Mark (InitString (" %s:\n")), quoted)) ;
+   RETURN ConCat (fmt, message)
+END GetAnnounceScope ;
+
+
+(*
+
    AnnounceScope - return the error string s with a scope description prepended
                    assuming that scope has changed.
 *)
 
-PROCEDURE AnnounceScope (e: Error; s: String) : String ;
+PROCEDURE AnnounceScope (e: Error; message: String) : String ;
 VAR
-   desc,
-   pre,
-   quoted,
-   filename,
-   fmt     : String ;
+   filename: String ;
 BEGIN
    IF (scopeKind#e^.scopeKind) OR (scopeName#e^.scopeName) OR (lastKind#e^.scopeKind)
    THEN
@@ -827,29 +862,9 @@ BEGIN
       scopeName := e^.scopeName ;
       Assert (e^.scopeKind # noscope) ;
       filename := FindFileNameFromToken (e^.token, 0) ;
-      IF filename = NIL
-      THEN
-         pre := InitString ('')
-      ELSE
-         pre := Sprintf1 (Mark (InitString ("%s: ")), filename)
-      END ;
-      quoted := quoteOpen (InitString ('')) ;
-      quoted := ConCat (quoted, Mark (InitStringCharStar (KeyToCharStar (scopeName)))) ;
-      quoted := quoteClose (quoted) ;
-      CASE scopeKind OF
-
-      definition    :   desc := InitString ("In definition module") |
-      implementation:   desc := InitString ("In implementation module") |
-      program       :   desc := InitString ("In program module") |
-      module        :   desc := InitString ("In inner module") |
-      procedure     :   desc := InitString ("In procedure")
-
-      END ;
-      fmt := ConCat (pre, desc) ;
-      fmt := ConCat (fmt, Sprintf1 (Mark (InitString (" %s:\n")), quoted)) ;
-      s := ConCat (fmt, s)
+      message := GetAnnounceScope (filename, message)
    END ;
-   RETURN s
+   RETURN message
 END AnnounceScope ;
 
 
diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod
index 1e3a6402f15..0f9675f9bbb 100644
--- a/gcc/m2/gm2-compiler/M2Range.mod
+++ b/gcc/m2/gm2-compiler/M2Range.mod
@@ -56,9 +56,13 @@ FROM M2Debug IMPORT Assert ;
 FROM Indexing IMPORT Index, InitIndex, InBounds, PutIndice, GetIndice ;
 FROM Storage IMPORT ALLOCATE ;
 FROM M2ALU IMPORT PushIntegerTree, PushInt, ConvertToInt, Equ, Gre, Less, GreEqu ;
-FROM M2Error IMPORT Error, InternalError, ErrorFormat0, ErrorFormat1, ErrorFormat2, FlushErrors ;
 FROM M2Options IMPORT VariantValueChecking ;
 
+FROM M2Error IMPORT Error, InternalError, ErrorFormat0, ErrorFormat1, ErrorFormat2, FlushErrors,
+                    GetAnnounceScope ;
+
+FROM M2ColorString IMPORT quoteOpen, quoteClose ;
+
 FROM M2MetaError IMPORT MetaError1, MetaError2, MetaError3,
                         MetaErrorT0, MetaErrorT1, MetaErrorT2, MetaErrorT3,
                         MetaErrorsT1, MetaErrorsT2, MetaErrorsT3, MetaErrorsT4,
@@ -2320,9 +2324,10 @@ BEGIN
          BuildStringParamLoc (location, errorMessage) ;
          IF function = NIL
          THEN
-            scope := InitString ('the global scope')
+            scope := GetAnnounceScope (filename, NIL)
          ELSE
-            scope := InitStringCharStar (function)
+            scope := quoteOpen (InitString ('')) ;
+            scope := ConCat (InitString ("procedure "), quoteClose (scope))
          END ;
          BuildStringParamLoc (location, scope) ;
          BuildParam (location, BuildIntegerConstant (column)) ;
diff --git a/gcc/m2/gm2-gcc/rtegraph.c b/gcc/m2/gm2-gcc/rtegraph.c
index 4780573faf5..cf85e2d0aca 100644
--- a/gcc/m2/gm2-gcc/rtegraph.c
+++ b/gcc/m2/gm2-gcc/rtegraph.c
@@ -362,8 +362,8 @@ generate_report (gimple *stmt, const char *report, diagnostic_t kind)
 	  /* continue to use scope as this will survive any
 	     optimization transforms.  */
 	  location_t location = gimple_location (stmt);
-	  rte_error_at (location, kind, "%s, %s (in %s)\n",
-			report, message, scope);
+	  rte_error_at (location, kind, "In %s\n%s, %s",
+			scope, report, message);
 	}
     }
 }
diff --git a/gcc/m2/gm2-libs/RTExceptions.mod b/gcc/m2/gm2-libs/RTExceptions.mod
index 7e59881893e..9ca0e87884e 100644
--- a/gcc/m2/gm2-libs/RTExceptions.mod
+++ b/gcc/m2/gm2-libs/RTExceptions.mod
@@ -288,22 +288,27 @@ VAR
 BEGIN
    currentEHB^.number := number ;
    i := 0 ;
-   addFile(file, i) ;
-   addChar(':', i) ;
-   addNum(line, i) ;
-   addChar(':', i) ;
-   addNum(column, i) ;
-   addChar(':', i) ;
-   addStr(message, i) ;
-   addChar(' ', i) ;
-   addChar('(', i) ;
-   addChar('i', i) ;
-   addChar('n', i) ;
-   addChar(' ', i) ;
-   addStr(function, i) ;
-   addChar(')', i) ;
-   addChar(nl, i) ;
-   addChar(nul, i) ;
+   addFile (file, i) ;
+   addChar (':', i) ;
+   addNum (line, i) ;
+   addChar (':', i) ;
+   addNum (column, i) ;
+   addChar (':', i) ;
+   addChar (' ', i) ;
+   addChar ('I', i) ;
+   addChar ('n', i) ;
+   addChar (' ', i) ;
+   addStr (function, i) ;
+   addChar (nl, i) ;
+   addFile (file, i) ;
+   addChar (':', i) ;
+   addNum (line, i) ;
+   addChar (':', i) ;
+   addNum (column, i) ;
+   addChar (':', i) ;
+   addStr (message, i) ;
+   addChar (nl, i) ;
+   addChar (nul, i) ;
    InvokeHandler
 END Raise ;


^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2021-11-18 10:08 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-11-18 10:08 [gcc/devel/modula-2] Runtime errors emit errors using GCC scope heading and message style Gaius Mulley

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).