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> 2014-08-01 Robert Dewar <dewar@adacore.com>
* sem_ch7.adb, einfo.adb, einfo.ads, sem_ch13.adb: Minor change of * sem_ch7.adb, einfo.adb, einfo.ads, sem_ch13.adb: Minor change of
......
gcc/ada/s-regpat.adb
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1986 by University of Toronto. -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -410,10 +410,13 @@ package body System.Regpat is ...@@ -410,10 +410,13 @@ package body System.Regpat is
procedure Parse procedure Parse
(Parenthesized : Boolean; (Parenthesized : Boolean;
Capturing : Boolean;
Flags : out Expression_Flags; Flags : out Expression_Flags;
IP : out Pointer); IP : out Pointer);
-- Parse regular expression, i.e. main body or parenthesized thing -- Parse regular expression, i.e. main body or parenthesized thing
-- Caller must absorb opening parenthesis. -- 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 procedure Parse_Branch
(Flags : out Expression_Flags; (Flags : out Expression_Flags;
...@@ -831,9 +834,10 @@ package body System.Regpat is ...@@ -831,9 +834,10 @@ package body System.Regpat is
-- the branches to what follows makes it hard to avoid. -- the branches to what follows makes it hard to avoid.
procedure Parse procedure Parse
(Parenthesized : Boolean; (Parenthesized : Boolean;
Flags : out Expression_Flags; Capturing : Boolean;
IP : out Pointer) Flags : out Expression_Flags;
IP : out Pointer)
is is
E : String renames Expression; E : String renames Expression;
Br, Br2 : Pointer; Br, Br2 : Pointer;
...@@ -847,7 +851,7 @@ package body System.Regpat is ...@@ -847,7 +851,7 @@ package body System.Regpat is
-- Make an OPEN node, if parenthesized -- Make an OPEN node, if parenthesized
if Parenthesized then if Parenthesized and then Capturing then
if Matcher.Paren_Count > Max_Paren_Count then if Matcher.Paren_Count > Max_Paren_Count then
Fail ("too many ()"); Fail ("too many ()");
end if; end if;
...@@ -856,7 +860,6 @@ package body System.Regpat is ...@@ -856,7 +860,6 @@ package body System.Regpat is
Matcher.Paren_Count := Matcher.Paren_Count + 1; Matcher.Paren_Count := Matcher.Paren_Count + 1;
IP := Emit_Node (OPEN); IP := Emit_Node (OPEN);
Emit (Character'Val (Par_No)); Emit (Character'Val (Par_No));
else else
IP := 0; IP := 0;
Par_No := 0; Par_No := 0;
...@@ -913,14 +916,19 @@ package body System.Regpat is ...@@ -913,14 +916,19 @@ package body System.Regpat is
-- Make a closing node, and hook it on the end -- Make a closing node, and hook it on the end
if Parenthesized then if Parenthesized then
Ender := Emit_Node (CLOSE); if Capturing then
Emit (Character'Val (Par_No)); 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 else
Ender := Emit_Node (EOP); Ender := Emit_Node (EOP);
Link_Tail (IP, Ender);
end if; end if;
Link_Tail (IP, Ender);
if Have_Branch and then Emit_Ptr <= PM.Size + 1 then if Have_Branch and then Emit_Ptr <= PM.Size + 1 then
-- Hook the tails of the branches to the closing node -- Hook the tails of the branches to the closing node
...@@ -945,7 +953,7 @@ package body System.Regpat is ...@@ -945,7 +953,7 @@ package body System.Regpat is
elsif Parse_Pos <= Parse_End then elsif Parse_Pos <= Parse_End then
if E (Parse_Pos) = ')' then if E (Parse_Pos) = ')' then
Fail ("unmatched ()"); Fail ("unmatched ')'");
else else
Fail ("junk on end"); -- "Can't happen" Fail ("junk on end"); -- "Can't happen"
end if; end if;
...@@ -1003,16 +1011,24 @@ package body System.Regpat is ...@@ -1003,16 +1011,24 @@ package body System.Regpat is
New_Flags : Expression_Flags; New_Flags : Expression_Flags;
begin begin
Parse (True, New_Flags, IP); if Parse_Pos <= Parse_End - 1
and then Expression (Parse_Pos) = '?'
if IP = 0 then and then Expression (Parse_Pos + 1) = ':'
return; 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; 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; end;
when '|' | ASCII.LF | ')' => when '|' | ASCII.LF | ')' =>
...@@ -1971,7 +1987,7 @@ package body System.Regpat is ...@@ -1971,7 +1987,7 @@ package body System.Regpat is
-- Start of processing for Compile -- Start of processing for Compile
begin begin
Parse (False, Expr_Flags, Result); Parse (False, False, Expr_Flags, Result);
if Result = 0 then if Result = 0 then
Fail ("Couldn't compile expression"); Fail ("Couldn't compile expression");
......
gcc/ada/s-regpat.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1986 by University of Toronto. -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -78,8 +78,10 @@ package System.Regpat is ...@@ -78,8 +78,10 @@ package System.Regpat is
-- ::= [^ range range ...] -- matches any character not listed -- ::= [^ range range ...] -- matches any character not listed
-- ::= . -- matches any single character -- ::= . -- matches any single character
-- -- except newlines -- -- except newlines
-- ::= ( expr ) -- parens used for grouping -- ::= ( expr ) -- parenthesis used for grouping
-- ::= \ num -- reference to num-th parenthesis -- ::= (?: expr ) -- non-capturing parenthesis
-- ::= \ num -- reference to num-th capturing
-- parenthesis
-- range ::= char - char -- matches chars in given range -- range ::= char - char -- matches chars in given range
-- ::= nchr -- ::= nchr
...@@ -345,6 +347,9 @@ package System.Regpat is ...@@ -345,6 +347,9 @@ package System.Regpat is
-- N'th parenthesized subexpressions; Matches (0) is for the whole -- N'th parenthesized subexpressions; Matches (0) is for the whole
-- expression. -- 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 -- For instance, if your regular expression is: "a((b*)c+)(d+)", then
-- 12 3 -- 12 3
-- Matches (0) is for "a((b*)c+)(d+)" (the entire expression) -- 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 ...@@ -2915,6 +2915,21 @@ package body Sem_Ch13 is
-- that verifed that there was a matching convention -- that verifed that there was a matching convention
-- is now obsolete. -- 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; goto Continue;
end if; end if;
...@@ -2930,7 +2945,7 @@ package body Sem_Ch13 is ...@@ -2930,7 +2945,7 @@ package body Sem_Ch13 is
and then Nkind (Parent (N)) /= N_Compilation_Unit and then Nkind (Parent (N)) /= N_Compilation_Unit
then then
Error_Msg_N Error_Msg_N
("incorrect context for library unit aspect&", Id); ("incorrect context for library unit aspect&", Id);
goto Continue; goto Continue;
end if; end if;
......
gcc/ada/sem_prag.adb
...@@ -7838,8 +7838,14 @@ package body Sem_Prag is ...@@ -7838,8 +7838,14 @@ package body Sem_Prag is
-- the code generator making an implicit initialization explicit. -- the code generator making an implicit initialization explicit.
elsif Present (Expression (Parent (Def_Id))) 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 then
-- Set imported flag to prevent cascaded errors.
Set_Is_Imported (Def_Id);
Error_Msg_Sloc := Sloc (Def_Id); Error_Msg_Sloc := Sloc (Def_Id);
Error_Pragma_Arg Error_Pragma_Arg
("no initialization allowed for declaration of& #", ("no initialization allowed for declaration of& #",
...@@ -7847,7 +7853,13 @@ package body Sem_Prag is ...@@ -7847,7 +7853,13 @@ package body Sem_Prag is
Arg2); Arg2);
else 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); Process_Interface_Name (Def_Id, Arg3, Arg4);
-- Note that we do not set Is_Public here. That's because we -- Note that we do not set Is_Public here. That's because we
...@@ -7922,7 +7934,12 @@ package body Sem_Prag is ...@@ -7922,7 +7934,12 @@ package body Sem_Prag is
exit; exit;
else 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 -- 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