[multiple changes]
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. From-SVN: r213447
This commit is contained in:
Arnaud Charlet
parent
7b4ebba523
commit
8894aa20ff
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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");
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue