Skip to content

R
riscv-gcc-1
Commit 8894aa20 by Arnaud Charlet
Options

[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
parent 7b4ebba5
Showing with 97 additions and 28 deletions
gcc/ada/ChangeLog
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
......
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");
......
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)
......
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;
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment