Commit 70b70ce8 by Arnaud Charlet

[multiple changes]

2009-04-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Analyze_Subprogram_Renaming): Improve error message on
	box-defaulted operator in an instantiation, when the type of the
	operands is not directly visible.

2009-04-29  Gary Dismukes  <dismukes@adacore.com>

	* sem_aggr.adb (Valid_Limited_Ancestor): Undo previous change.
	(Resolve_Extension_Aggregate): Call Check_Parameterless_Call after the
	analysis of the ancestor part. Remove prohibition against limited
	interpretations of the ancestor expression in the case of Ada 2005.
	Revise error message in overloaded case, adding a message to cover
	the Ada 2005 case.

2009-04-29  Thomas Quinot  <quinot@adacore.com>

	* xoscons.adb: Minor reformatting

2009-04-29  Bob Duff  <duff@adacore.com>

	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Do not ignore
	attribute_definition_clauses for the following attributes when the
	-gnatI switch is used: External_Tag, Input, Output, Read, Storage_Pool,
	Storage_Size, Write. Otherwise, we get spurious errors (for example,
	missing Read attribute on remote types).

	* gnat_ugn.texi: Document the change, and add a stern warning.

2009-04-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Check_Local_Access): Indicate that value tracing is
	disabled not just for the current scope, but for the innermost dynamic
	scope as well.

From-SVN: r146979
parent 4cc51f5e
2009-04-29 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming): Improve error message on
box-defaulted operator in an instantiation, when the type of the
operands is not directly visible.
2009-04-29 Gary Dismukes <dismukes@adacore.com>
* sem_aggr.adb (Valid_Limited_Ancestor): Undo previous change.
(Resolve_Extension_Aggregate): Call Check_Parameterless_Call after the
analysis of the ancestor part. Remove prohibition against limited
interpretations of the ancestor expression in the case of Ada 2005.
Revise error message in overloaded case, adding a message to cover
the Ada 2005 case.
2009-04-29 Thomas Quinot <quinot@adacore.com>
* xoscons.adb: Minor reformatting
2009-04-29 Bob Duff <duff@adacore.com>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Do not ignore
attribute_definition_clauses for the following attributes when the
-gnatI switch is used: External_Tag, Input, Output, Read, Storage_Pool,
Storage_Size, Write. Otherwise, we get spurious errors (for example,
missing Read attribute on remote types).
* gnat_ugn.texi: Document the change, and add a stern warning.
2009-04-29 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Check_Local_Access): Indicate that value tracing is
disabled not just for the current scope, but for the innermost dynamic
scope as well.
2009-04-29 Arnaud Charlet <charlet@adacore.com> 2009-04-29 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Make-lang.in: Update dependencies * gcc-interface/Make-lang.in: Update dependencies
......
...@@ -4175,11 +4175,17 @@ see @ref{Character Set Control}. ...@@ -4175,11 +4175,17 @@ see @ref{Character Set Control}.
@item ^-gnatI^/IGNORE_REP_CLAUSES^ @item ^-gnatI^/IGNORE_REP_CLAUSES^
@cindex @option{^-gnatI^IGNORE_REP_CLAUSES^} (@command{gcc}) @cindex @option{^-gnatI^IGNORE_REP_CLAUSES^} (@command{gcc})
Ignore representation clauses. When this switch is used, all Ignore representation clauses. When this switch is used,
representation clauses are treated as comments. This is useful representation clauses are treated as comments. This is useful
when initially porting code where you want to ignore rep clause when initially porting code where you want to ignore rep clause
problems, and also for compiling foreign code (particularly problems, and also for compiling foreign code (particularly
for use with ASIS). for use with ASIS). The representation clauses that are ignored
are: enumeration_representation_clause, record_representation_clause,
and attribute_definition_clause for the following attributes:
Address, Alignment, Bit_Order, Component_Size, Machine_Radix,
Object_Size, Size, Small, Stream_Size, and Value_Size.
Note that this option should be used only for compiling -- the
code is likely to malfunction at run time.
@item -gnatjnn @item -gnatjnn
@cindex @option{-gnatjnn} (@command{gcc}) @cindex @option{-gnatjnn} (@command{gcc})
...@@ -2147,14 +2147,6 @@ package body Sem_Aggr is ...@@ -2147,14 +2147,6 @@ package body Sem_Aggr is
elsif Nkind_In (Anc, N_Aggregate, N_Function_Call) then elsif Nkind_In (Anc, N_Aggregate, N_Function_Call) then
return True; return True;
-- Check for a function name, to cover the case of a parameterless
-- function call which hasn't been resolved yet.
elsif Is_Entity_Name (Anc)
and then Ekind (Entity (Anc)) = E_Function
then
return True;
elsif Nkind (Anc) = N_Attribute_Reference elsif Nkind (Anc) = N_Attribute_Reference
and then Attribute_Name (Anc) = Name_Input and then Attribute_Name (Anc) = Name_Input
then then
...@@ -2208,7 +2200,11 @@ package body Sem_Aggr is ...@@ -2208,7 +2200,11 @@ package body Sem_Aggr is
-- Start of processing for Resolve_Extension_Aggregate -- Start of processing for Resolve_Extension_Aggregate
begin begin
-- Analyze the ancestor part and account for the case where it's
-- a parameterless function call.
Analyze (A); Analyze (A);
Check_Parameterless_Call (A);
if not Is_Tagged_Type (Typ) then if not Is_Tagged_Type (Typ) then
Error_Msg_N ("type of extension aggregate must be tagged", N); Error_Msg_N ("type of extension aggregate must be tagged", N);
...@@ -2255,8 +2251,11 @@ package body Sem_Aggr is ...@@ -2255,8 +2251,11 @@ package body Sem_Aggr is
Get_First_Interp (A, I, It); Get_First_Interp (A, I, It);
while Present (It.Typ) loop while Present (It.Typ) loop
-- Only consider limited interpretations in the Ada 2005 case
if Is_Tagged_Type (It.Typ) if Is_Tagged_Type (It.Typ)
and then not Is_Limited_Type (It.Typ) and then (Ada_Version >= Ada_05
or else not Is_Limited_Type (It.Typ))
then then
if A_Type /= Any_Type then if A_Type /= Any_Type then
Error_Msg_N ("cannot resolve expression", A); Error_Msg_N ("cannot resolve expression", A);
...@@ -2270,8 +2269,13 @@ package body Sem_Aggr is ...@@ -2270,8 +2269,13 @@ package body Sem_Aggr is
end loop; end loop;
if A_Type = Any_Type then if A_Type = Any_Type then
if Ada_Version >= Ada_05 then
Error_Msg_N ("ancestor part must be of a tagged type", A);
else
Error_Msg_N Error_Msg_N
("ancestor part must be non-limited tagged type", A); ("ancestor part must be of a nonlimited tagged type", A);
end if;
return; return;
end if; end if;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2009, 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- --
...@@ -420,7 +420,8 @@ package body Sem_Attr is ...@@ -420,7 +420,8 @@ package body Sem_Attr is
-- an access, we set a flag to kill all tracked values on any call -- an access, we set a flag to kill all tracked values on any call
-- because this access value may be passed around, and any called -- because this access value may be passed around, and any called
-- code might use it to access a local procedure which clobbers a -- code might use it to access a local procedure which clobbers a
-- tracked value. -- tracked value. If the scope is a loop or block, indicate that
-- value tracking is disabled for the enclosing subprogram.
function Get_Kind (E : Entity_Id) return Entity_Kind; function Get_Kind (E : Entity_Id) return Entity_Kind;
-- Distinguish between access to regular/protected subprograms -- Distinguish between access to regular/protected subprograms
...@@ -433,6 +434,8 @@ package body Sem_Attr is ...@@ -433,6 +434,8 @@ package body Sem_Attr is
begin begin
if not Is_Library_Level_Entity (E) then if not Is_Library_Level_Entity (E) then
Set_Suppress_Value_Tracking_On_Call (Current_Scope); Set_Suppress_Value_Tracking_On_Call (Current_Scope);
Set_Suppress_Value_Tracking_On_Call
(Nearest_Dynamic_Scope (Current_Scope));
end if; end if;
end Check_Local_Access; end Check_Local_Access;
......
...@@ -692,8 +692,40 @@ package body Sem_Ch13 is ...@@ -692,8 +692,40 @@ package body Sem_Ch13 is
begin begin
if Ignore_Rep_Clauses then if Ignore_Rep_Clauses then
case Id is
-- The following should be ignored
when Attribute_Address |
Attribute_Alignment |
Attribute_Bit_Order |
Attribute_Component_Size |
Attribute_Machine_Radix |
Attribute_Object_Size |
Attribute_Size |
Attribute_Small |
Attribute_Stream_Size |
Attribute_Value_Size =>
Rewrite (N, Make_Null_Statement (Sloc (N))); Rewrite (N, Make_Null_Statement (Sloc (N)));
return; return;
-- The following should not be ignored
when Attribute_External_Tag |
Attribute_Input |
Attribute_Output |
Attribute_Read |
Attribute_Storage_Pool |
Attribute_Storage_Size |
Attribute_Write =>
null;
-- Other cases are errors, which will be caught below
when others =>
null;
end case;
end if; end if;
Analyze (Nam); Analyze (Nam);
......
...@@ -2370,10 +2370,12 @@ package body Sem_Ch8 is ...@@ -2370,10 +2370,12 @@ package body Sem_Ch8 is
declare declare
F1 : Entity_Id; F1 : Entity_Id;
F2 : Entity_Id; F2 : Entity_Id;
T1 : Entity_Id;
begin begin
F1 := First_Formal (Candidate_Renaming); F1 := First_Formal (Candidate_Renaming);
F2 := First_Formal (New_S); F2 := First_Formal (New_S);
T1 := First_Subtype (Etype (F1));
while Present (F1) and then Present (F2) loop while Present (F1) and then Present (F2) loop
Next_Formal (F1); Next_Formal (F1);
...@@ -2390,6 +2392,15 @@ package body Sem_Ch8 is ...@@ -2390,6 +2392,15 @@ package body Sem_Ch8 is
("\missing specification for &", Spec, F1); ("\missing specification for &", Spec, F1);
end if; end if;
end if; end if;
if Nkind (Nam) = N_Operator_Symbol
and then From_Default (N)
then
Error_Msg_Node_2 := T1;
Error_Msg_NE
("default & on & is not directly visible",
Nam, Nam);
end if;
end; end;
end if; end if;
end if; end if;
...@@ -5040,10 +5051,12 @@ package body Sem_Ch8 is ...@@ -5040,10 +5051,12 @@ package body Sem_Ch8 is
Candidate_Renaming := Empty; Candidate_Renaming := Empty;
if not Is_Overloaded (Nam) then if not Is_Overloaded (Nam) then
if Entity_Matches_Spec (Entity (Nam), New_S) if Entity_Matches_Spec (Entity (Nam), New_S) then
and then Is_Visible_Operation (Entity (Nam)) Candidate_Renaming := New_S;
then
if Is_Visible_Operation (Entity (Nam)) then
Old_S := Entity (Nam); Old_S := Entity (Nam);
end if;
elsif elsif
Present (First_Formal (Entity (Nam))) Present (First_Formal (Entity (Nam)))
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2008, Free Software Foundation, Inc. -- -- Copyright (C) 2008-2009, 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- --
...@@ -30,7 +30,7 @@ ...@@ -30,7 +30,7 @@
-- - the preprocessed C file: s-oscons-tmplt.i -- - the preprocessed C file: s-oscons-tmplt.i
-- - the generated assembly file: s-oscons-tmplt.s -- - the generated assembly file: s-oscons-tmplt.s
-- The contents of s-oscons.ads is written on standard output -- The contents of s-oscons.ads is written on standard output.
with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Exceptions; use Ada.Exceptions; with Ada.Exceptions; use Ada.Exceptions;
...@@ -59,13 +59,13 @@ procedure XOSCons is ...@@ -59,13 +59,13 @@ procedure XOSCons is
-- Information retrieved from assembly listing -- -- Information retrieved from assembly listing --
------------------------------------------------- -------------------------------------------------
-- We need to deal with integer values that can be signed or unsigned,
-- so we need to cater for the maximum range of both cases.
type String_Access is access all String; type String_Access is access all String;
-- Note: we can't use GNAT.Strings for this definition, since that unit -- Note: we can't use GNAT.Strings for this definition, since that unit
-- is not available in older base compilers. -- is not available in older base compilers.
-- We need to deal with integer values that can be signed or unsigned, so
-- we need to accomodate the maximum range of both cases.
type Int_Value_Type is record type Int_Value_Type is record
Positive : Boolean; Positive : Boolean;
Abs_Value : Long_Unsigned := 0; Abs_Value : Long_Unsigned := 0;
...@@ -75,8 +75,8 @@ procedure XOSCons is ...@@ -75,8 +75,8 @@ procedure XOSCons is
(CND, -- Constant (decimal) (CND, -- Constant (decimal)
CNS, -- Constant (freeform string) CNS, -- Constant (freeform string)
TXT); -- Literal text TXT); -- Literal text
-- Recognized markers found in assembly file. These markers are produced -- Recognized markers found in assembly file. These markers are produced by
-- by the same-named macros from the C template. -- the same-named macros from the C template.
type Asm_Info (Kind : Asm_Info_Kind := TXT) is record type Asm_Info (Kind : Asm_Info_Kind := TXT) is record
Line_Number : Integer; Line_Number : Integer;
...@@ -98,8 +98,8 @@ procedure XOSCons is ...@@ -98,8 +98,8 @@ procedure XOSCons is
-- Additional descriptive comment for constant, or free-form text (TXT) -- Additional descriptive comment for constant, or free-form text (TXT)
end record; end record;
package Asm_Infos is new GNAT.Table ( package Asm_Infos is new GNAT.Table
Table_Component_Type => Asm_Info, (Table_Component_Type => Asm_Info,
Table_Index_Type => Integer, Table_Index_Type => Integer,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 100, Table_Initial => 100,
...@@ -107,7 +107,7 @@ procedure XOSCons is ...@@ -107,7 +107,7 @@ procedure XOSCons is
Max_Const_Name_Len : Natural := 0; Max_Const_Name_Len : Natural := 0;
Max_Constant_Value_Len : Natural := 0; Max_Constant_Value_Len : Natural := 0;
-- Longest name and longest value lengths -- Lengths of longest name and longest value
type Language is (Lang_Ada, Lang_C); type Language is (Lang_Ada, Lang_C);
...@@ -152,6 +152,7 @@ procedure XOSCons is ...@@ -152,6 +152,7 @@ procedure XOSCons is
Info : Asm_Info renames Asm_Infos.Table (Info_Index); Info : Asm_Info renames Asm_Infos.Table (Info_Index);
procedure Put (S : String); procedure Put (S : String);
-- Write S to OFile
--------- ---------
-- Put -- -- Put --
...@@ -253,9 +254,7 @@ procedure XOSCons is ...@@ -253,9 +254,7 @@ procedure XOSCons is
-- On some platforms, immediate integer values are prefixed with -- On some platforms, immediate integer values are prefixed with
-- a $ or # character in assembly output. -- a $ or # character in assembly output.
if S (First) = '$' if S (First) = '$' or else S (First) = '#' then
or else S (First) = '#'
then
First := First + 1; First := First + 1;
end if; end if;
...@@ -306,6 +305,7 @@ procedure XOSCons is ...@@ -306,6 +305,7 @@ procedure XOSCons is
if Info.Kind = CND then if Info.Kind = CND then
Info.Int_Value := Parse_Int (Line (Index1 .. Index2 - 1)); Info.Int_Value := Parse_Int (Line (Index1 .. Index2 - 1));
Info.Value_Len := Index2 - Index1 - 1; Info.Value_Len := Index2 - Index1 - 1;
else else
Info.Text_Value := Field_Alloc; Info.Text_Value := Field_Alloc;
Info.Value_Len := Info.Text_Value'Length; Info.Value_Len := Info.Text_Value'Length;
...@@ -322,8 +322,8 @@ procedure XOSCons is ...@@ -322,8 +322,8 @@ procedure XOSCons is
if Info.Kind = TXT then if Info.Kind = TXT then
Info.Text_Value := Info.Comment; Info.Text_Value := Info.Comment;
-- Update Max_Constant_Value_Len, but only if this constant has -- Update Max_Constant_Value_Len, but only if this constant has a
-- a comment (else the value is allowed to be longer). -- comment (else the value is allowed to be longer).
elsif Info.Comment'Length > 0 then elsif Info.Comment'Length > 0 then
if Info.Value_Len > Max_Constant_Value_Len then if Info.Value_Len > Max_Constant_Value_Len then
...@@ -446,6 +446,7 @@ begin ...@@ -446,6 +446,7 @@ begin
Output_Info (Lang_C, C_OFile, Current_Info); Output_Info (Lang_C, C_OFile, Current_Info);
Current_Info := Current_Info + 1; Current_Info := Current_Info + 1;
end if; end if;
Current_Line := Current_Line + 1; Current_Line := Current_Line + 1;
end if; end if;
end loop; end loop;
......
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