Commit d606f1df by Arnaud Charlet

[multiple changes]

2010-08-10  Robert Dewar  <dewar@adacore.com>

	* a-suenco.adb (Convert): Fix bug in UTF-16 to UTF-8 conversion for
	codes in the range 16#80#..16#7FF#.
	* sem_ch10.adb: Minor reformatting.

2010-08-10  Arnaud Charlet  <charlet@adacore.com>

	* gnat1drv.adb (Scan_Front_End_Switches): Always perform semantics and
	generate ali files in CodePeer mode, so that a gnatmake -c -k will
	proceed further when possible
	* freeze.adb (Freeze_Static_Object): Fix thinko. Do not generate error
	messages when ignoring representation clauses (-gnatI).

2010-08-10  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_N_Selected_Component): Do not attempt to
	constant-fold discriminant reference if the constraint is an object
	with non-static expression. Expression may contain volatile references
	in the presence of renamings.

2010-08-10  Vincent Celier  <celier@adacore.com>

	* prj-proc.adb (Get_Attribute_Index): If Index is All_Other_Names,
	returns Index.
	* prj-strt.adb (Attribute_Reference): Recognize 'others' as a valid
	index for an associative array where it is allowed.

From-SVN: r163060
parent 1f92d7f2
2010-08-10 Robert Dewar <dewar@adacore.com>
* a-suenco.adb (Convert): Fix bug in UTF-16 to UTF-8 conversion for
codes in the range 16#80#..16#7FF#.
* sem_ch10.adb: Minor reformatting.
2010-08-10 Arnaud Charlet <charlet@adacore.com>
* gnat1drv.adb (Scan_Front_End_Switches): Always perform semantics and
generate ali files in CodePeer mode, so that a gnatmake -c -k will
proceed further when possible
* freeze.adb (Freeze_Static_Object): Fix thinko. Do not generate error
messages when ignoring representation clauses (-gnatI).
2010-08-10 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb (Expand_N_Selected_Component): Do not attempt to
constant-fold discriminant reference if the constraint is an object
with non-static expression. Expression may contain volatile references
in the presence of renamings.
2010-08-10 Vincent Celier <celier@adacore.com>
* prj-proc.adb (Get_Attribute_Index): If Index is All_Other_Names,
returns Index.
* prj-strt.adb (Attribute_Reference): Recognize 'others' as a valid
index for an associative array where it is allowed.
2010-08-10 Thomas Quinot <quinot@adacore.com>
* exp_attr.adb: Add comments.
......
......@@ -34,7 +34,7 @@
package body Ada.Strings.UTF_Encoding.Conversions is
use Interfaces;
-- Version convertion from UTF-8/UTF-16BE/LE to UTF-8/UTF-16BE/LE
-- Convert from UTF-8/UTF-16BE/LE to UTF-8/UTF-16BE/LE
function Convert
(Item : UTF_String;
......@@ -57,7 +57,7 @@ package body Ada.Strings.UTF_Encoding.Conversions is
end if;
end Convert;
-- Version converting UTF-8/UTF-16BE/LE to UTF-16
-- Convert from UTF-8/UTF-16BE/LE to UTF-16
function Convert
(Item : UTF_String;
......@@ -72,7 +72,7 @@ package body Ada.Strings.UTF_Encoding.Conversions is
end if;
end Convert;
-- Version converting UTF-8 to UTF-16
-- Convert from UTF-8 to UTF-16
function Convert
(Item : UTF_8_String;
......@@ -316,7 +316,7 @@ package body Ada.Strings.UTF_Encoding.Conversions is
elsif C1 <= 16#07FF# then
Result (Len + 1) :=
Character'Val
(2#110_000000# or Shift_Right (C1, 6));
(2#110_00000# or Shift_Right (C1, 6));
Result (Len + 2) :=
Character'Val
(2#10_000000# or (C1 and 2#00_111111#));
......
......@@ -7358,6 +7358,7 @@ package body Exp_Ch4 is
Disc : Entity_Id;
New_N : Node_Id;
Dcon : Elmt_Id;
Dval : Node_Id;
function In_Left_Hand_Side (Comp : Node_Id) return Boolean;
-- Gigi needs a temporary for prefixes that depend on a discriminant,
......@@ -7472,18 +7473,6 @@ package body Exp_Ch4 is
then
null;
-- If this is a discriminant of a component of a mutable record,
-- or a renaming of such, no optimization is possible, and value
-- must be retrieved anew. Note that in the previous case we may
-- be dealing with a renaming declaration, while here we may have
-- a use of a renaming.
elsif Nkind (P) = N_Selected_Component
and then Is_Record_Type (Etype (Prefix (P)))
and then not Is_Constrained (Etype (Prefix (P)))
then
null;
-- Don't do this optimization if we are within the code for a
-- discriminant check, since the whole point of such a check may
-- be to verify the condition on which the code below depends!
......@@ -7501,7 +7490,9 @@ package body Exp_Ch4 is
Disc := First_Discriminant (Ptyp);
Dcon := First_Elmt (Discriminant_Constraint (Ptyp));
Discr_Loop : while Present (Dcon) loop
Dval := Node (Dcon);
-- Check if this is the matching discriminant
......@@ -7512,9 +7503,30 @@ package body Exp_Ch4 is
-- constrained by an outer discriminant, which cannot
-- be optimized away.
if
Denotes_Discriminant
(Node (Dcon), Check_Concurrent => True)
if Denotes_Discriminant
(Dval, Check_Concurrent => True)
then
exit Discr_Loop;
elsif Nkind (Original_Node (Dval)) = N_Selected_Component
and then
Denotes_Discriminant
(Selector_Name (Original_Node (Dval)), True)
then
exit Discr_Loop;
-- Do not retrieve value if constraint is not static. It
-- is generally not useful, and the constraint may be a
-- rewritten outer discriminant in which case it is in
-- fact incorrect.
elsif Is_Entity_Name (Dval)
and then Nkind (Parent (Entity (Dval)))
= N_Object_Declaration
and then Present (Expression (Parent (Entity (Dval))))
and then
not Is_Static_Expression
(Expression (Parent (Entity (Dval))))
then
exit Discr_Loop;
......@@ -7524,14 +7536,14 @@ package body Exp_Ch4 is
-- missing cases.
elsif Nkind (Parent (N)) = N_Case_Statement
and then Etype (Node (Dcon)) /= Etype (Disc)
and then Etype (Dval) /= Etype (Disc)
then
Rewrite (N,
Make_Qualified_Expression (Loc,
Subtype_Mark =>
New_Occurrence_Of (Etype (Disc), Loc),
Expression =>
New_Copy_Tree (Node (Dcon))));
New_Copy_Tree (Dval)));
Analyze_And_Resolve (N, Etype (Disc));
-- In case that comes out as a static expression,
......@@ -7548,7 +7560,7 @@ package body Exp_Ch4 is
-- yet, and this must be done now.
else
Rewrite (N, New_Copy_Tree (Node (Dcon)));
Rewrite (N, New_Copy_Tree (Dval));
Analyze_And_Resolve (N);
Set_Is_Static_Expression (N, False);
return;
......
......@@ -5100,10 +5100,16 @@ package body Freeze is
-- issue an error message saying that this object cannot be imported
-- or exported. If it has an address clause it is an overlay in the
-- current partition and the static requirement is not relevant.
-- Do not issue any error message when ignoring rep clauses.
if Is_Imported (E) and then No (Address_Clause (E)) then
Error_Msg_N
("& cannot be imported (local type is not constant)", E);
if Ignore_Rep_Clauses then
null;
elsif Is_Imported (E) then
if No (Address_Clause (E)) then
Error_Msg_N
("& cannot be imported (local type is not constant)", E);
end if;
-- Otherwise must be exported, something is wrong if compiler
-- is marking something as statically allocated which cannot be).
......
......@@ -255,6 +255,12 @@ procedure Gnat1drv is
-- front-end warnings when we are getting CodePeer output.
Reset_Style_Check_Options;
-- Always perform semantics and generate ali files in CodePeer mode,
-- so that a gnatmake -c -k will proceed further when possible.
Force_ALI_Tree_File := True;
Try_Semantics := True;
end if;
-- Set Configurable_Run_Time mode if system.ads flag set
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
-- --
-- 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- --
......@@ -460,6 +460,10 @@ package body Prj.Proc is
Lower : Boolean;
begin
if Index = All_Other_Names then
return Index;
end if;
Get_Name_String (Index);
Lower := Case_Insensitive (Attr, Tree);
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
-- --
-- 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- --
......@@ -230,19 +230,35 @@ package body Prj.Strt is
if Token = Tok_Left_Paren then
Scan (In_Tree);
Expect (Tok_String_Literal, "literal string");
if Token = Tok_String_Literal then
if Others_Allowed_For (Current_Attribute)
and then Token = Tok_Others
then
Set_Associative_Array_Index_Of
(Reference, In_Tree, To => Token_Name);
(Reference, In_Tree, To => All_Other_Names);
Scan (In_Tree);
Expect (Tok_Right_Paren, "`)`");
if Token = Tok_Right_Paren then
else
if Others_Allowed_For (Current_Attribute) then
Expect
(Tok_String_Literal, "literal string or others");
else
Expect (Tok_String_Literal, "literal string");
end if;
if Token = Tok_String_Literal then
Set_Associative_Array_Index_Of
(Reference, In_Tree, To => Token_Name);
Scan (In_Tree);
end if;
end if;
end if;
Expect (Tok_Right_Paren, "`)`");
if Token = Tok_Right_Paren then
Scan (In_Tree);
end if;
end if;
end if;
......
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