https://gcc.gnu.org/g:a281df31144e7d324e983700af9cb9cfeba3e87e
commit r17-5449-ga281df31144e7d324e983700af9cb9cfeba3e87e Author: Jose E. Marchesi <[email protected]> Date: Mon Oct 5 09:06:59 2026 +0200 a68: implement extension GNU68-2026-002-nestable-pragmats 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. Diff: --- 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 +++ gcc/testsuite/algol68/compile/error-pragmat-1.a68 | 2 +- .../algol68/compile/error-pragmat-access-1.a68 | 2 +- .../algol68/compile/error-pragmat-access-2.a68 | 4 +- gcc/testsuite/algol68/compile/include-supper.a68 | 4 +- .../algol68/compile/supper-pr-is-tag-1.a68 | 5 ++ 13 files changed, 124 insertions(+), 18 deletions(-) diff --git a/gcc/algol68/a68-lang.cc b/gcc/algol68/a68-lang.cc index cf39453f99f4..2f6d837acd94 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 ac1b7573d7df..d81f11e47eee 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 3fcb202b0be6..824d83d0028a 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 530b0d81ab96..d763d5b5b1fa 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 ce8df69d1119..17f8a03966b1 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 1a511ca6d44d..d0c24c545db7 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 0f28fcc726ac..a593b4ea42bc 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 000000000000..c85df06b6ac3 --- /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 8c5f1c1d899d..c996517f8a98 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 2eb4ceb7ef51..0761d67fafa3 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 643fcce07736..4909de5743e6 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 af0521be1019..a3eee332b763 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 000000000000..80a3d2c4f860 --- /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
