Signed-off-by: Jose E. Marchesi <[email protected]>
gcc/algol68/ChangeLog
* ga68.vw: Add syntax for nested pragmats.
* ga68.texi (Dialect options): Document that -fbrackets can only
be used in upper storpping.
* a68-parser-scanner.cc (skip_pragmat): Likewise.
(next_preprocessor_item): Likewise.
(pragment): Likewise.
(get_next_token): Likewise.
(tokenise_source): Likewise.
* a68-parser-pragmat.cc (handle_access_in_pragmat): Handle nested
pragmats.
(handle_pragmat): Likewise.
* a68-parser-keywords.cc (a68_set_up_tables): Add symbols for
BOLD_PRAGMAT_SYMBOL and STYLE_I_PRAGMAT_SYMBOL in both upper and
supper stropping.
* a68-parser-attrs.def (BOLD_PRAGMAT_BEGIN_SYMBOL): New AST
attribute.
(BOLD_PRAGMAT_END_SYMBOL): Likewise.
(STYLE_I_PRAGMAT_BEGIN_SYMBOL): Likewise.
(STYLE_I_PRAGMAT_END_SYMBOL): Likewise.
* a68-lang.cc (a68_post_options): -fbrackets is not compatible
with supper stropping.
gcc/testsuite/ChangeLog
* algol68/compile/include-supper.a68: Likewise.
* algol68/compile/error-pragmat-access-2.a68: Likewise.
* algol68/compile/error-pragmat-access-1.a68: Likewise.
* algol68/compile/error-pragmat-1.a68: Use nestable pragmats in
test.
* algol68/compile/error-fbrackets-1.a68: New test.
* algol68/compile/supper-pr-is-tag-1.a68: Likewise.
---
gcc/algol68/a68-lang.cc | 5 ++
gcc/algol68/a68-parser-attrs.def | 4 ++
gcc/algol68/a68-parser-keywords.cc | 8 ++-
gcc/algol68/a68-parser-pragmat.cc | 14 ++--
gcc/algol68/a68-parser-scanner.cc | 68 ++++++++++++++++++-
gcc/algol68/ga68.texi | 3 +-
gcc/algol68/ga68.vw | 16 ++++-
.../algol68/compile/error-fbrackets-1.a68 | 7 ++
.../algol68/compile/error-pragmat-1.a68 | 2 +-
.../compile/error-pragmat-access-1.a68 | 2 +-
.../compile/error-pragmat-access-2.a68 | 4 +-
.../algol68/compile/include-supper.a68 | 4 +-
.../algol68/compile/supper-pr-is-tag-1.a68 | 5 ++
13 files changed, 124 insertions(+), 18 deletions(-)
create mode 100644 gcc/testsuite/algol68/compile/error-fbrackets-1.a68
create mode 100644 gcc/testsuite/algol68/compile/supper-pr-is-tag-1.a68
diff --git a/gcc/algol68/a68-lang.cc b/gcc/algol68/a68-lang.cc
index cf39453f99f..2f6d837acd9 100644
--- a/gcc/algol68/a68-lang.cc
+++ b/gcc/algol68/a68-lang.cc
@@ -691,6 +691,11 @@ a68_post_options (const char **filename ATTRIBUTE_UNUSED)
/* No psABI change warnings for Algol 68. */
warn_psabi = 0;
+ /* Check for incompatible combinations of comand-line options. */
+ if (!OPTION_STRICT (&A68_JOB) && OPTION_BRACKETS (&A68_JOB))
+ fatal_error (UNKNOWN_LOCATION,
+ "%<-fbrackets%> can only be used with UPPER stroping.");
+
return false;
}
diff --git a/gcc/algol68/a68-parser-attrs.def b/gcc/algol68/a68-parser-attrs.def
index ac1b7573d7d..d81f11e47ee 100644
--- a/gcc/algol68/a68-parser-attrs.def
+++ b/gcc/algol68/a68-parser-attrs.def
@@ -52,6 +52,8 @@ A68_ATTR(BOLD_COMMENT_SYMBOL, "comment delimiter")
A68_ATTR(BOLD_COMMENT_BEGIN_SYMBOL, "comment opening delimiter")
A68_ATTR(BOLD_COMMENT_END_SYMBOL, "comment closing delimiter")
A68_ATTR(BOLD_PRAGMAT_SYMBOL, "pragmat-symbol")
+A68_ATTR(BOLD_PRAGMAT_BEGIN_SYMBOL, "pragmat opening delimiter")
+A68_ATTR(BOLD_PRAGMAT_END_SYMBOL, "pragmat closing delimiter")
A68_ATTR(BOLD_TAG, "bold tag")
A68_ATTR(BOOLEAN_PATTERN, "boolean pattern")
A68_ATTR(BOOL_SYMBOL, "bool-symbol")
@@ -359,6 +361,8 @@ A68_ATTR(STRUCT_SYMBOL, "struct-symbol")
A68_ATTR(STYLE_II_COMMENT_SYMBOL, "comment delimiter")
A68_ATTR(STYLE_I_COMMENT_SYMBOL, "comment delimiter")
A68_ATTR(STYLE_I_PRAGMAT_SYMBOL, "pragmat-symbol")
+A68_ATTR(STYLE_I_PRAGMAT_BEGIN_SYMBOL, "pragmat opening delimiter")
+A68_ATTR(STYLE_I_PRAGMAT_END_SYMBOL, "pragmat closing delimiter")
A68_ATTR(SUB_SYMBOL, "sub-symbol")
A68_ATTR(SUB_UNIT, "sub unit")
A68_ATTR(TERTIARY, "tertiary")
diff --git a/gcc/algol68/a68-parser-keywords.cc
b/gcc/algol68/a68-parser-keywords.cc
index 3fcb202b0be..824d83d0028 100644
--- a/gcc/algol68/a68-parser-keywords.cc
+++ b/gcc/algol68/a68-parser-keywords.cc
@@ -147,6 +147,8 @@ a68_set_up_tables (void)
add_keyword (&A68 (top_keyword), ORF_SYMBOL, "OREL");
add_keyword (&A68 (top_keyword), BRIEF_COMMENT_BEGIN_SYMBOL, "{");
add_keyword (&A68 (top_keyword), BRIEF_COMMENT_END_SYMBOL, "}");
+ add_keyword (&A68 (top_keyword), STYLE_I_PRAGMAT_BEGIN_SYMBOL, "[[");
+ add_keyword (&A68 (top_keyword), STYLE_I_PRAGMAT_END_SYMBOL, "]]");
add_keyword (&A68 (top_keyword), QUOTE_SYMBOL, "'");
add_keyword (&A68 (top_keyword), WORD_SYMBOL, "WORD");
@@ -154,6 +156,8 @@ a68_set_up_tables (void)
{
add_keyword (&A68 (top_keyword), BOLD_COMMENT_BEGIN_SYMBOL, "NOTE");
add_keyword (&A68 (top_keyword), BOLD_COMMENT_END_SYMBOL, "ETON");
+ add_keyword (&A68 (top_keyword), BOLD_PRAGMAT_BEGIN_SYMBOL, "ORDER");
+ add_keyword (&A68 (top_keyword), BOLD_PRAGMAT_END_SYMBOL, "REDRO");
}
/* Symbols from MR. */
@@ -176,6 +180,8 @@ a68_set_up_tables (void)
add_keyword (&A68 (top_keyword), STYLE_I_COMMENT_SYMBOL, "CO");
add_keyword (&A68 (top_keyword), BOLD_COMMENT_SYMBOL, "COMMENT");
add_keyword (&A68 (top_keyword), STYLE_II_COMMENT_SYMBOL, "#");
+ add_keyword (&A68 (top_keyword), BOLD_PRAGMAT_SYMBOL, "PRAGMAT");
+ add_keyword (&A68 (top_keyword), STYLE_I_PRAGMAT_SYMBOL, "PR");
}
add_keyword (&A68 (top_keyword), POINT_SYMBOL, ".");
@@ -201,7 +207,6 @@ a68_set_up_tables (void)
add_keyword (&A68 (top_keyword), ASSIGN_TO_SYMBOL, "=:");
add_keyword (&A68 (top_keyword), COMPL_SYMBOL, "COMPL");
add_keyword (&A68 (top_keyword), FROM_SYMBOL, "FROM");
- add_keyword (&A68 (top_keyword), BOLD_PRAGMAT_SYMBOL, "PRAGMAT");
add_keyword (&A68 (top_keyword), DO_SYMBOL, "DO");
add_keyword (&A68 (top_keyword), CASE_SYMBOL, "CASE");
add_keyword (&A68 (top_keyword), LOC_SYMBOL, "LOC");
@@ -224,7 +229,6 @@ a68_set_up_tables (void)
add_keyword (&A68 (top_keyword), OD_SYMBOL, "OD");
add_keyword (&A68 (top_keyword), OF_SYMBOL, "OF");
add_keyword (&A68 (top_keyword), STRUCT_SYMBOL, "STRUCT");
- add_keyword (&A68 (top_keyword), STYLE_I_PRAGMAT_SYMBOL, "PR");
add_keyword (&A68 (top_keyword), BUS_SYMBOL, "]");
add_keyword (&A68 (top_keyword), SKIP_SYMBOL, "SKIP");
add_keyword (&A68 (top_keyword), SHORT_SYMBOL, "SHORT");
diff --git a/gcc/algol68/a68-parser-pragmat.cc
b/gcc/algol68/a68-parser-pragmat.cc
index 530b0d81ab9..d763d5b5b1f 100644
--- a/gcc/algol68/a68-parser-pragmat.cc
+++ b/gcc/algol68/a68-parser-pragmat.cc
@@ -86,21 +86,22 @@ const char *
handle_access_in_pragmat (NODE_T *p, const char *pragmat, size_t pos)
{
const char *beginning = pragmat;
-
SKIP_WHITESPACES (pragmat);
/* Parse module name. */
char *module;
PARSE_WORD (pragmat, module);
if (*module == '\0')
{
- a68_error (p, "invalid pragmat: expected module name after %<access%>");
+ a68_error_in_pragmat (p, pos + pragmat - beginning,
+ "invalid pragmat: expected module name after
%<access%>");
return NULL;
}
SKIP_WHITESPACES (pragmat);
/* Parse "in " */
- if (strncmp (pragmat, "in ", 3) != 0)
+ if (strncmp (pragmat, "in ", 2) != 0)
{
- a68_error (p, "invalid pragmat: expected %<in%> after module name");
+ a68_error_in_pragmat (p, pos + pragmat - beginning,
+ "invalid pragmat: expected %<in%> after module
name");
return NULL;
}
pragmat += 3;
@@ -137,6 +138,8 @@ handle_access_in_pragmat (NODE_T *p, const char *pragmat,
size_t pos)
/* Skip closing PR or PRAGMAT. */
if (NPRAGMAT_TYPE (p) == STYLE_I_PRAGMAT_SYMBOL)
pragmat += 2;
+ else if (NPRAGMAT_TYPE (p) == STYLE_I_PRAGMAT_BEGIN_SYMBOL)
+ pragmat += 2;
else
pragmat += 7;
@@ -153,6 +156,7 @@ handle_pragmat (NODE_T *p)
const char *pragmat = NPRAGMAT (p);
if (pragmat != NULL
&& (NPRAGMAT_TYPE (p) == STYLE_I_PRAGMAT_SYMBOL
+ || NPRAGMAT_TYPE (p) == STYLE_I_PRAGMAT_BEGIN_SYMBOL
|| NPRAGMAT_TYPE (p) == BOLD_PRAGMAT_SYMBOL))
{
/* Process pragmat commands. */
@@ -162,6 +166,8 @@ handle_pragmat (NODE_T *p)
/* Skip PR or PRAGMAT. */
if (NPRAGMAT_TYPE (p) == STYLE_I_PRAGMAT_SYMBOL)
pragmat += 2;
+ else if (NPRAGMAT_TYPE (p) == STYLE_I_PRAGMAT_BEGIN_SYMBOL)
+ pragmat += 2;
else
pragmat += 7;
SKIP_WHITESPACES (pragmat);
diff --git a/gcc/algol68/a68-parser-scanner.cc
b/gcc/algol68/a68-parser-scanner.cc
index ce8df69d111..17f8a03966b 100644
--- a/gcc/algol68/a68-parser-scanner.cc
+++ b/gcc/algol68/a68-parser-scanner.cc
@@ -631,12 +631,24 @@ skip_pragmat (LINE_T **top, char **ch, int delim, bool
whitespace)
*ch = &v[1];
return true;
}
+ else if (is_bold (v, "REDRO") && delim == BOLD_PRAGMAT_BEGIN_SYMBOL)
+ {
+ *top = u;
+ *ch = &v[1];
+ return true;
+ }
else if (is_bold (v, "PR") && delim == STYLE_I_PRAGMAT_SYMBOL)
{
*top = u;
*ch = &v[1];
return true;
}
+ else if (v[0] == ']' && v[1] == ']' && delim ==
STYLE_I_PRAGMAT_BEGIN_SYMBOL)
+ {
+ *top = u;
+ *ch = &v[1];
+ return true;
+ }
else
{
if (whitespace && !ISSPACE (v[0]) && v[0] != NEWLINE_CHAR)
@@ -758,7 +770,14 @@ next_preprocessor_item (LINE_T **top, char **ch, int
*delim)
SCAN_ERROR (!skip_comment (&u, &v, BRIEF_COMMENT_BEGIN_SYMBOL),
start_l, start_c,
"unterminated comment");
}
- else if (is_bold (v, "PRAGMAT") || is_bold (v, "PR"))
+ else if ((a68_find_keyword (A68 (top_keyword), "PRAGMAT") !=
NO_KEYWORD
+ && is_bold (v, "PRAGMAT"))
+ || (a68_find_keyword (A68 (top_keyword), "PR") != NO_KEYWORD
+ && is_bold (v, "PR"))
+ || (a68_find_keyword (A68 (top_keyword), "ORDER") !=
NO_KEYWORD
+ && is_bold (v, "ORDER"))
+ || (a68_find_keyword (A68 (top_keyword), "[[") != NO_KEYWORD
+ && v[0] == '[' && v[1] == '['))
{
/* We caught a PRAGMAT. */
char *item;
@@ -772,6 +791,13 @@ next_preprocessor_item (LINE_T **top, char **ch, int
*delim)
*delim = STYLE_I_PRAGMAT_SYMBOL;
v = &v[strlen ("PR")];
}
+ else if (v[0] == '[' && v[1] == '['
+ && !OPTION_STRICT (&A68_JOB)
+ && OPTION_STROPPING (&A68_JOB) == SUPPER_STROPPING)
+ {
+ *delim = STYLE_I_PRAGMAT_BEGIN_SYMBOL;
+ v = &v[strlen ("[[")];
+ }
item = get_pragmat_item (&u, &v);
SCAN_ERROR (item == NO_TEXT, start_l, start_c,
"unterminated pragmat");
@@ -1209,6 +1235,11 @@ pragment (int type, LINE_T **ref_l, char **ref_c)
term_s = "pr";
pragmat = true;
}
+ else if (type == STYLE_I_PRAGMAT_BEGIN_SYMBOL)
+ {
+ term_s = "]]";
+ pragmat = true;
+ }
else if (type == BOLD_PRAGMAT_SYMBOL)
{
term_s = "pragmat";
@@ -1828,7 +1859,37 @@ string break character point"));
sym[0] = '\0';
*att = (in_format ? LITERAL : ROW_CHAR_DENOTATION);
}
- else if (strchr ("#$()[]{},;@", c) != NO_TEXT)
+ else if (c == '['
+ && !OPTION_STRICT (&A68_JOB)
+ && OPTION_STROPPING (&A68_JOB) == SUPPER_STROPPING)
+ {
+ /* Either a single [ or [[ for a pragmat. */
+ (sym++)[0] = c;
+ c = next_char (ref_l, ref_s, false);
+ if (c == '[')
+ {
+ (sym++)[0] = c;
+ (void) next_char (ref_l, ref_s, false);
+ }
+ sym[0] = '\0';
+ *att = STOP;
+ }
+ else if (c == ']'
+ && !OPTION_STRICT (&A68_JOB)
+ && OPTION_STROPPING (&A68_JOB) == SUPPER_STROPPING)
+ {
+ /* Either a single ] or ]] for a pragmat. */
+ (sym++)[0] = c;
+ c = next_char (ref_l, ref_s, false);
+ if (c == ']')
+ {
+ (sym++)[0] = c;
+ (void) next_char (ref_l, ref_s, false);
+ }
+ sym[0] = '\0';
+ *att = STOP;
+ }
+ else if (strchr ("#$(){}[],;@", c) != NO_TEXT)
{
/* Single character symbols. */
(sym++)[0] = c;
@@ -2183,7 +2244,8 @@ tokenise_source (NODE_T **root, int level, bool in_format,
make_node = false;
}
else if (att == STYLE_I_PRAGMAT_SYMBOL
- || att == BOLD_PRAGMAT_SYMBOL)
+ || att == BOLD_PRAGMAT_SYMBOL
+ || att == STYLE_I_PRAGMAT_BEGIN_SYMBOL)
{
char *nlpr = pragment (ATTRIBUTE (kw), l, s);
if (pragmat_lpr == NO_TEXT
diff --git a/gcc/algol68/ga68.texi b/gcc/algol68/ga68.texi
index 1a511ca6d44..d0c24c545db 100644
--- a/gcc/algol68/ga68.texi
+++ b/gcc/algol68/ga68.texi
@@ -192,7 +192,8 @@ This option controls whether @code{[ .. ]} is considered
equivalent to
@code{( .. )}. This syntactic variation is blessed by the Revised
Report and is still strict Algol 68.
-This option is disabled by default.
+This option is disabled by default and can only be activated in UPPER
+stropping.
@end table
@node Directory options
diff --git a/gcc/algol68/ga68.vw b/gcc/algol68/ga68.vw
index 0f28fcc726a..a593b4ea42b 100644
--- a/gcc/algol68/ga68.vw
+++ b/gcc/algol68/ga68.vw
@@ -50,6 +50,8 @@
adds support for non-cummulative sizetys of some fixed sizes
like `word', `single', `double', etc.
+ [NP] This is the GNU68-2025-006-nestable-pragmats GNU extension.
+
The metaproduction rules, hyper-rules and hyper-alternatives
introduced by each extension are clearly marked in the sections
below. You can easily search for them using the extensions tags in
@@ -1874,7 +1876,8 @@ h) *symbol : NOTION symbol{94a,b,c,d,e,f,g,h}.
9.2.1 Syntax
{ Extensions:
- [NC] nestable comments. }
+ [NC] nestable comments.
+ [NP] nestable pragmats.}
A) PRAGMENT :: pragmat ; comment.
@@ -1883,7 +1886,8 @@ b) PRAGMENT{a} :
STYLE PRAGMENT symbol{94h,-},
STYLE PRAGMENT item{c} sequence option,
STYLE PRAGMENT symbol{94h,-} ;
- STYLE nestable comment{d}.
+ STYLE nestable comment{d} ;
+ STYLE nestable pragmat{g}.
c) STYLE PRAGMENT item{b} :
character glyph{814c} ; STYLE other PRAGMENT item{d}.
d) STYLE nestable comment{b} :
@@ -1895,6 +1899,10 @@ e) STYLE nestable comment contents{d} :
STYLE nestable comment{d} option.
f) STYLE nestable comment item{e} :
character glyph{814c} ; STYLE other nestable comment item{d}.
+g) STYLE nestable pragmat{b} :
+ STYLE pragmat begin symbol@{94h,-},
+ STYLE PRAGMENT item{c} sequence option,
+ STYLE pragmat end symbol{94h,-}.
{ A production rule may be added for each notion designated by 'STYLE
other PRAGMENT item' each of whose alternatives is a symbol
@@ -1938,8 +1946,12 @@ f) unsafe symbol{37a} UNSAFE
brief of symbol{53a} '
h) bold comment begin symbol{92a} NOTE
bold comment end symbol{92a} ETON
+ bold pragmat begin symbol ORDER
+ bold pragmat end symbol REDRO
brief comment begin symbol{92a} {
brief comment end symbol{92a} }
+ style i pragmat begin symbol [[
+ style i pragmat end symbol ]]
10.1.1 Syntax
diff --git a/gcc/testsuite/algol68/compile/error-fbrackets-1.a68
b/gcc/testsuite/algol68/compile/error-fbrackets-1.a68
new file mode 100644
index 00000000000..c85df06b6ac
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/error-fbrackets-1.a68
@@ -0,0 +1,7 @@
+{ dg-do compile }
+{ dg-options "-fstropping=supper -fbrackets" }
+
+(~)
+
+{ dg-error "-fbrackets" "-fbrackets" {target *-*-*} 0 }
+{ dg-prune-output "compilation terminated" }
diff --git a/gcc/testsuite/algol68/compile/error-pragmat-1.a68
b/gcc/testsuite/algol68/compile/error-pragmat-1.a68
index 8c5f1c1d899..c996517f8a9 100644
--- a/gcc/testsuite/algol68/compile/error-pragmat-1.a68
+++ b/gcc/testsuite/algol68/compile/error-pragmat-1.a68
@@ -1,4 +1,4 @@
-{ dg-error "unrecognized pragmat" } pr invalid Foo in "module" pr
+{ dg-error "unrecognized pragmat" } [[invalid Foo in "module"]]
begin prio // = 8;
op (int,int)int // = lala;
diff --git a/gcc/testsuite/algol68/compile/error-pragmat-access-1.a68
b/gcc/testsuite/algol68/compile/error-pragmat-access-1.a68
index 2eb4ceb7ef5..0761d67fafa 100644
--- a/gcc/testsuite/algol68/compile/error-pragmat-access-1.a68
+++ b/gcc/testsuite/algol68/compile/error-pragmat-access-1.a68
@@ -1,4 +1,4 @@
-pr access Foo in pr { dg-error "expected string" }
+[[access Foo in]] { dg-error "expected string" }
begin prio // = 8;
op (int,int)int // = lala;
diff --git a/gcc/testsuite/algol68/compile/error-pragmat-access-2.a68
b/gcc/testsuite/algol68/compile/error-pragmat-access-2.a68
index 643fcce0773..4909de5743e 100644
--- a/gcc/testsuite/algol68/compile/error-pragmat-access-2.a68
+++ b/gcc/testsuite/algol68/compile/error-pragmat-access-2.a68
@@ -1,5 +1,5 @@
-pr access Foo in "lala" pr
-pr access Foo in "lele" pr { dg-error "multiple" }
+[[access Foo in "lala"]]
+[[access Foo in "lele"]] { dg-error "multiple" }
begin prio // = 8;
op (int,int)int // = lala;
diff --git a/gcc/testsuite/algol68/compile/include-supper.a68
b/gcc/testsuite/algol68/compile/include-supper.a68
index af0521be101..a3eee332b76 100644
--- a/gcc/testsuite/algol68/compile/include-supper.a68
+++ b/gcc/testsuite/algol68/compile/include-supper.a68
@@ -5,8 +5,8 @@ begin string name := "Algol68 with supper!";
{ Both files are in `./a68includes'.
The first one will be included because we uwed `-I.
The second one will be included because of the relative path. }
- pr include "hello-supper.a68" pr
- pr include "a68includes/goodbye-supper.a68" pr
+ [[include "hello-supper.a68"]]
+ [[include "a68includes/goodbye-supper.a68"]]
string bye := goodbye(name);
string hi := hello(name);
diff --git a/gcc/testsuite/algol68/compile/supper-pr-is-tag-1.a68
b/gcc/testsuite/algol68/compile/supper-pr-is-tag-1.a68
new file mode 100644
index 00000000000..80a3d2c4f86
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/supper-pr-is-tag-1.a68
@@ -0,0 +1,5 @@
+{ pr and pragmat are valid tags in SUPPER stropping. }
+
+begin int pr = 10, pragmat = 20;
+ skip
+end
--
2.39.5
