From 8894aa20ff573ed8cc3d317199fbcbfbcd03c159 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 1 Aug 2014 12:15:59 +0200 Subject: [PATCH] [multiple changes] 2014-08-01 Ed Schonberg * sem_ch13.adb (Analyze_Aspect_Specifications, case Aspect_Import): Set Is_Imported flag at once, to simplify subsequent legality checks. Reject the aspect on an object whose declaration has an explicit initial value. * sem_prag.adb (Process_Import_Or_Interface): Use original node to check legality of an initial value for an imported entity. Set Is_Imported flag in case of error to prevent cascaded errors. Do not set the Is_Imported flag if the pragma comes from an aspect, because it is already done when analyzing the aspect. 2014-08-01 Emmanuel Briot * g-regpat.adb (Parse): Add support for non-capturing parenthesis. From-SVN: r213447 --- gcc/ada/ChangeLog | 16 ++++++++++++ gcc/ada/s-regpat.adb | 58 ++++++++++++++++++++++++++++---------------- gcc/ada/s-regpat.ads | 11 ++++++--- gcc/ada/sem_ch13.adb | 17 ++++++++++++- gcc/ada/sem_prag.adb | 23 +++++++++++++++--- 5 files changed, 97 insertions(+), 28 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 31bc891508a..7f190853be6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2014-08-01 Ed Schonberg + + * sem_ch13.adb (Analyze_Aspect_Specifications, case Aspect_Import): + Set Is_Imported flag at once, to simplify subsequent legality + checks. Reject the aspect on an object whose declaration has an + explicit initial value. + * sem_prag.adb (Process_Import_Or_Interface): Use original node + to check legality of an initial value for an imported entity. + Set Is_Imported flag in case of error to prevent cascaded errors. + Do not set the Is_Imported flag if the pragma comes from an + aspect, because it is already done when analyzing the aspect. + +2014-08-01 Emmanuel Briot + + * g-regpat.adb (Parse): Add support for non-capturing parenthesis. + 2014-08-01 Robert Dewar * sem_ch7.adb, einfo.adb, einfo.ads, sem_ch13.adb: Minor change of diff --git a/gcc/ada/s-regpat.adb b/gcc/ada/s-regpat.adb index d32bb03f06d..842b6e362c2 100644 --- a/gcc/ada/s-regpat.adb +++ b/gcc/ada/s-regpat.adb @@ -7,7 +7,7 @@ -- B o d y -- -- -- -- Copyright (C) 1986 by University of Toronto. -- --- Copyright (C) 1999-2013, AdaCore -- +-- Copyright (C) 1999-2014, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -410,10 +410,13 @@ package body System.Regpat is procedure Parse (Parenthesized : Boolean; + Capturing : Boolean; Flags : out Expression_Flags; IP : out Pointer); -- Parse regular expression, i.e. main body or parenthesized thing -- Caller must absorb opening parenthesis. + -- Capturing should be set to True when we have an open parenthesis + -- from which we want the user to extra text. procedure Parse_Branch (Flags : out Expression_Flags; @@ -831,9 +834,10 @@ package body System.Regpat is -- the branches to what follows makes it hard to avoid. procedure Parse - (Parenthesized : Boolean; - Flags : out Expression_Flags; - IP : out Pointer) + (Parenthesized : Boolean; + Capturing : Boolean; + Flags : out Expression_Flags; + IP : out Pointer) is E : String renames Expression; Br, Br2 : Pointer; @@ -847,7 +851,7 @@ package body System.Regpat is -- Make an OPEN node, if parenthesized - if Parenthesized then + if Parenthesized and then Capturing then if Matcher.Paren_Count > Max_Paren_Count then Fail ("too many ()"); end if; @@ -856,7 +860,6 @@ package body System.Regpat is Matcher.Paren_Count := Matcher.Paren_Count + 1; IP := Emit_Node (OPEN); Emit (Character'Val (Par_No)); - else IP := 0; Par_No := 0; @@ -913,14 +916,19 @@ package body System.Regpat is -- Make a closing node, and hook it on the end if Parenthesized then - Ender := Emit_Node (CLOSE); - Emit (Character'Val (Par_No)); + if Capturing then + Ender := Emit_Node (CLOSE); + Emit (Character'Val (Par_No)); + Link_Tail (IP, Ender); + else + -- need to keep looking after the closing parenthesis + null; + end if; else Ender := Emit_Node (EOP); + Link_Tail (IP, Ender); end if; - Link_Tail (IP, Ender); - if Have_Branch and then Emit_Ptr <= PM.Size + 1 then -- Hook the tails of the branches to the closing node @@ -945,7 +953,7 @@ package body System.Regpat is elsif Parse_Pos <= Parse_End then if E (Parse_Pos) = ')' then - Fail ("unmatched ()"); + Fail ("unmatched ')'"); else Fail ("junk on end"); -- "Can't happen" end if; @@ -1003,16 +1011,24 @@ package body System.Regpat is New_Flags : Expression_Flags; begin - Parse (True, New_Flags, IP); - - if IP = 0 then - return; + if Parse_Pos <= Parse_End - 1 + and then Expression (Parse_Pos) = '?' + and then Expression (Parse_Pos + 1) = ':' + then + Parse_Pos := Parse_Pos + 2; + -- non-capturing parenthesis + Parse (True, False, New_Flags, IP); + else + -- capturing parenthesis + Parse (True, True, New_Flags, IP); + Expr_Flags.Has_Width := + Expr_Flags.Has_Width or else New_Flags.Has_Width; + Expr_Flags.SP_Start := + Expr_Flags.SP_Start or else New_Flags.SP_Start; + if IP = 0 then + return; + end if; end if; - - Expr_Flags.Has_Width := - Expr_Flags.Has_Width or else New_Flags.Has_Width; - Expr_Flags.SP_Start := - Expr_Flags.SP_Start or else New_Flags.SP_Start; end; when '|' | ASCII.LF | ')' => @@ -1971,7 +1987,7 @@ package body System.Regpat is -- Start of processing for Compile begin - Parse (False, Expr_Flags, Result); + Parse (False, False, Expr_Flags, Result); if Result = 0 then Fail ("Couldn't compile expression"); diff --git a/gcc/ada/s-regpat.ads b/gcc/ada/s-regpat.ads index 74e617fcdfb..5c8bf5e1c3c 100644 --- a/gcc/ada/s-regpat.ads +++ b/gcc/ada/s-regpat.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1986 by University of Toronto. -- --- Copyright (C) 1996-2010, AdaCore -- +-- Copyright (C) 1996-2014, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -78,8 +78,10 @@ package System.Regpat is -- ::= [^ range range ...] -- matches any character not listed -- ::= . -- matches any single character -- -- except newlines - -- ::= ( expr ) -- parens used for grouping - -- ::= \ num -- reference to num-th parenthesis + -- ::= ( expr ) -- parenthesis used for grouping + -- ::= (?: expr ) -- non-capturing parenthesis + -- ::= \ num -- reference to num-th capturing + -- parenthesis -- range ::= char - char -- matches chars in given range -- ::= nchr @@ -345,6 +347,9 @@ package System.Regpat is -- N'th parenthesized subexpressions; Matches (0) is for the whole -- expression. -- + -- Non-capturing parenthesis (introduced with (?:...)) can not be + -- retrieved and do not count in the match array index. + -- -- For instance, if your regular expression is: "a((b*)c+)(d+)", then -- 12 3 -- Matches (0) is for "a((b*)c+)(d+)" (the entire expression) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 76c7a70eb28..86a36ced87f 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2915,6 +2915,21 @@ package body Sem_Ch13 is -- that verifed that there was a matching convention -- is now obsolete. + if A_Id = Aspect_Import then + Set_Is_Imported (E); + + -- An imported entity cannot have an explicit + -- initialization. + + if Nkind (N) = N_Object_Declaration + and then Present (Expression (N)) + then + Error_Msg_N + ("imported entities cannot be initialized " + & "(RM B.1(24))", Expression (N)); + end if; + end if; + goto Continue; end if; @@ -2930,7 +2945,7 @@ package body Sem_Ch13 is and then Nkind (Parent (N)) /= N_Compilation_Unit then Error_Msg_N - ("incorrect context for library unit aspect&", Id); + ("incorrect context for library unit aspect&", Id); goto Continue; end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index c5f778991c2..ea747791568 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -7838,8 +7838,14 @@ package body Sem_Prag is -- the code generator making an implicit initialization explicit. elsif Present (Expression (Parent (Def_Id))) - and then Comes_From_Source (Expression (Parent (Def_Id))) + and then Comes_From_Source + (Original_Node (Expression (Parent (Def_Id)))) then + + -- Set imported flag to prevent cascaded errors. + + Set_Is_Imported (Def_Id); + Error_Msg_Sloc := Sloc (Def_Id); Error_Pragma_Arg ("no initialization allowed for declaration of& #", @@ -7847,7 +7853,13 @@ package body Sem_Prag is Arg2); else - Set_Imported (Def_Id); + -- If the pragma comes from an aspect specification the + -- Is_Imported flag has already been set. + + if not From_Aspect_Specification (N) then + Set_Imported (Def_Id); + end if; + Process_Interface_Name (Def_Id, Arg3, Arg4); -- Note that we do not set Is_Public here. That's because we @@ -7922,7 +7934,12 @@ package body Sem_Prag is exit; else - Set_Imported (Def_Id); + -- If the pragma comes from an aspect specification the + -- Is_Imported flag has already been set. + + if not From_Aspect_Specification (N) then + Set_Imported (Def_Id); + end if; -- Reject an Import applied to an abstract subprogram -- 2.30.2