2014-08-01 Ed Schonberg <schonberg@adacore.com>

	* 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  <briot@adacore.com>

	* g-regpat.adb (Parse): Add support for non-capturing parenthesis.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213447 138bc75d-0d04-0410-961f-82ee72b054a4

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  <schonberg@adacore.com>
+
+	* 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  <briot@adacore.com>
+
+	* g-regpat.adb (Parse): Add support for non-capturing parenthesis.
+
 2014-08-01  Robert Dewar  <dewar@adacore.com>
 
 	* 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