Commit 8fde064e by Arnaud Charlet

[multiple changes]

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* errout.ads: Minor reformatting.
	* sem_eval.adb (Why_Not_Static): Now issues continuation messages
	(Why_Not_Static): Test for aggregates behind string literals.
	* sem_eval.ads (Why_Not_Static): Now issues continuation messages.

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Expand_Concatenation): Wrap expansion in
	Expressions_With_Actions.

2013-04-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Base_Types_Match): For an actual type in an
	instance, the base type may itself be a subtype, so find true
	base type to determine compatibility.

From-SVN: r197745
parent 354c3840
2013-04-11 Robert Dewar <dewar@adacore.com> 2013-04-11 Robert Dewar <dewar@adacore.com>
* errout.ads: Minor reformatting.
* sem_eval.adb (Why_Not_Static): Now issues continuation messages
(Why_Not_Static): Test for aggregates behind string literals.
* sem_eval.ads (Why_Not_Static): Now issues continuation messages.
2013-04-11 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_Concatenation): Wrap expansion in
Expressions_With_Actions.
2013-04-11 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Base_Types_Match): For an actual type in an
instance, the base type may itself be a subtype, so find true
base type to determine compatibility.
2013-04-11 Robert Dewar <dewar@adacore.com>
* s-osprim-mingw.adb, sem_ch3.adb, sem_prag.adb, sem_util.adb. * s-osprim-mingw.adb, sem_ch3.adb, sem_prag.adb, sem_util.adb.
makeutl.adb, sem_ch8.adb: Minor reformatting. makeutl.adb, sem_ch8.adb: Minor reformatting.
......
...@@ -242,7 +242,7 @@ package Errout is ...@@ -242,7 +242,7 @@ package Errout is
-- messages starting with the \ insertion character). The effect of the -- messages starting with the \ insertion character). The effect of the
-- use of ! in a parent message automatically applies to all of its -- use of ! in a parent message automatically applies to all of its
-- continuation messages (since we clearly don't want any case in which -- continuation messages (since we clearly don't want any case in which
-- continuations are separated from the parent message. It is allowable -- continuations are separated from the main message). It is allowable
-- to put ! in continuation messages, and the usual style is to include -- to put ! in continuation messages, and the usual style is to include
-- it, since it makes it clear that the continuation is part of an -- it, since it makes it clear that the continuation is part of an
-- unconditional message. -- unconditional message.
......
...@@ -3017,6 +3017,8 @@ package body Exp_Ch4 is ...@@ -3017,6 +3017,8 @@ package body Exp_Ch4 is
-- Start of processing for Expand_Concatenate -- Start of processing for Expand_Concatenate
-- Kirtchev
begin begin
-- Choose an appropriate computational type -- Choose an appropriate computational type
...@@ -3233,7 +3235,6 @@ package body Exp_Ch4 is ...@@ -3233,7 +3235,6 @@ package body Exp_Ch4 is
Prefix => Prefix =>
Duplicate_Subexpr (Opnd, Name_Req => True), Duplicate_Subexpr (Opnd, Name_Req => True),
Attribute_Name => Name_First); Attribute_Name => Name_First);
Set_Parent (Opnd_Low_Bound (NN), Opnd);
-- Capture last operand bounds if result could be null -- Capture last operand bounds if result could be null
...@@ -3244,7 +3245,6 @@ package body Exp_Ch4 is ...@@ -3244,7 +3245,6 @@ package body Exp_Ch4 is
Prefix => Prefix =>
Duplicate_Subexpr (Opnd, Name_Req => True), Duplicate_Subexpr (Opnd, Name_Req => True),
Attribute_Name => Name_First)); Attribute_Name => Name_First));
Set_Parent (Last_Opnd_Low_Bound, Opnd);
Last_Opnd_High_Bound := Last_Opnd_High_Bound :=
Convert_To (Ityp, Convert_To (Ityp,
...@@ -3252,7 +3252,6 @@ package body Exp_Ch4 is ...@@ -3252,7 +3252,6 @@ package body Exp_Ch4 is
Prefix => Prefix =>
Duplicate_Subexpr (Opnd, Name_Req => True), Duplicate_Subexpr (Opnd, Name_Req => True),
Attribute_Name => Name_Last)); Attribute_Name => Name_Last));
Set_Parent (Last_Opnd_High_Bound, Opnd);
end if; end if;
-- Capture length of operand in entity -- Capture length of operand in entity
...@@ -5182,6 +5181,10 @@ package body Exp_Ch4 is ...@@ -5182,6 +5181,10 @@ package body Exp_Ch4 is
Desig_Typ := Obj_Typ; Desig_Typ := Obj_Typ;
end if; end if;
-- Kirtchev J730-020
Desig_Typ := Base_Type (Desig_Typ);
-- Generate: -- Generate:
-- Ann : access [all] <Desig_Typ>; -- Ann : access [all] <Desig_Typ>;
...@@ -6721,6 +6724,8 @@ package body Exp_Ch4 is ...@@ -6721,6 +6724,8 @@ package body Exp_Ch4 is
-- Node which is to be replaced by the result of concatenating the nodes -- Node which is to be replaced by the result of concatenating the nodes
-- in the list Opnds. -- in the list Opnds.
-- Kirtchev
begin begin
-- Ensure validity of both operands -- Ensure validity of both operands
...@@ -6748,7 +6753,6 @@ package body Exp_Ch4 is ...@@ -6748,7 +6753,6 @@ package body Exp_Ch4 is
-- Now Cnode is the deepest concatenation, and its parents are the -- Now Cnode is the deepest concatenation, and its parents are the
-- concatenation nodes above, so now we process bottom up, doing the -- concatenation nodes above, so now we process bottom up, doing the
-- operations. We gather a string that is as long as possible up to five
-- operands. -- operands.
-- The outer loop runs more than once if more than one concatenation -- The outer loop runs more than once if more than one concatenation
...@@ -6768,7 +6772,27 @@ package body Exp_Ch4 is ...@@ -6768,7 +6772,27 @@ package body Exp_Ch4 is
Append (Right_Opnd (Cnode), Opnds); Append (Right_Opnd (Cnode), Opnds);
end loop Inner; end loop Inner;
Expand_Concatenate (Cnode, Opnds); -- Wrap the node to concatenate into an expression actions node to
-- keep it nicely packaged. This is useful in the case of an assert
-- pragma with a concatenation where we want to be able to delete
-- the concatenation and all its expansion stuff.
declare
Cnod : constant Node_Id := Relocate_Node (Cnode);
Typ : constant Entity_Id := Base_Type (Etype (Cnode));
begin
-- Note: use Rewrite rather than Replace here, so that for example
-- Why_Not_Static can find the original concatenation node OK!
Rewrite (Cnode,
Make_Expression_With_Actions (Sloc (Cnode),
Actions => New_List (Make_Null_Statement (Sloc (Cnode))),
Expression => Cnod));
Expand_Concatenate (Cnod, Opnds);
Analyze_And_Resolve (Cnode, Typ);
end;
exit Outer when Cnode = N; exit Outer when Cnode = N;
Cnode := Parent (Cnode); Cnode := Parent (Cnode);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -417,17 +417,17 @@ package Sem_Eval is ...@@ -417,17 +417,17 @@ package Sem_Eval is
procedure Why_Not_Static (Expr : Node_Id); procedure Why_Not_Static (Expr : Node_Id);
-- This procedure may be called after generating an error message that -- This procedure may be called after generating an error message that
-- complains that something is non-static. If it finds good reasons, it -- complains that something is non-static. If it finds good reasons,
-- generates one or more error messages pointing the appropriate offending -- it generates one or more continuation error messages pointing the
-- component of the expression. If no good reasons can be figured out, then -- appropriate offending component of the expression. If no good reasons
-- no messages are generated. The expectation here is that the caller has -- can be figured out, then no messages are generated. The expectation here
-- already issued a message complaining that the expression is non-static. -- is that the caller has already issued a message complaining that the
-- Note that this message should be placed using Error_Msg_F or -- expression is non-static. Note that this message should be placed using
-- Error_Msg_FE, so that it will sort before any messages placed by this -- Error_Msg_F or Error_Msg_FE, so that it will sort before any messages
-- call. Note that it is fine to call Why_Not_Static with something that is -- placed by this call. Note that it is fine to call Why_Not_Static with
-- not an expression, and usually this has no effect, but in some cases -- something that is not an expression, and usually this has no effect, but
-- (N_Parameter_Association or N_Range), it makes sense for the internal -- in some cases (N_Parameter_Association or N_Range), it makes sense for
-- recursive calls. -- the internal recursive calls.
procedure Initialize; procedure Initialize;
-- Initializes the internal data structures. Must be called before each -- Initializes the internal data structures. Must be called before each
......
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