+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
-- 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- --
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;
-- 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;
-- 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;
Matcher.Paren_Count := Matcher.Paren_Count + 1;
IP := Emit_Node (OPEN);
Emit (Character'Val (Par_No));
-
else
IP := 0;
Par_No := 0;
-- 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
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;
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 | ')' =>
-- 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");
-- 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- --
-- ::= [^ 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
-- 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)
-- 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;
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;
-- 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& #",
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
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