[multiple changes]
2014-07-31 Robert Dewar <dewar@adacore.com> * frontend.adb: Minor reformatting. * sem.adb: Minor reformatting. * sem_ch6.adb (Analyze_Null_Procedure): Set proper sloc for identifiers on rewrite. * par.adb: Minor comment updates. * a-ngelfu.adb (Cos): Minor simplification. * par-ch13.adb (Get_Aspect_Specifications): Improve messages and recovery for bad aspect. * exp_ch3.adb: Code clean up. * sem_util.ads: Minor comment correction. * sem_ch13.adb (Check_Array_Type): Properly handle large types. * sem_ch3.adb: Code clean up. * binderr.ads: Minor comment correction. 2014-07-31 Ed Schonberg <schonberg@adacore.com> * exp_disp.adb (Expand_Interface_Conversion): A call whose prefix is a static conversion to an interface type that is not class-wide is not dispatching. From-SVN: r213338
This commit is contained in:
Arnaud Charlet
parent
7bfff488f8
commit
9d2a20713d
|
|
@ -1,3 +1,25 @@
|
|||
2014-07-31 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* frontend.adb: Minor reformatting.
|
||||
* sem.adb: Minor reformatting.
|
||||
* sem_ch6.adb (Analyze_Null_Procedure): Set proper sloc for
|
||||
identifiers on rewrite.
|
||||
* par.adb: Minor comment updates.
|
||||
* a-ngelfu.adb (Cos): Minor simplification.
|
||||
* par-ch13.adb (Get_Aspect_Specifications): Improve messages
|
||||
and recovery for bad aspect.
|
||||
* exp_ch3.adb: Code clean up.
|
||||
* sem_util.ads: Minor comment correction.
|
||||
* sem_ch13.adb (Check_Array_Type): Properly handle large types.
|
||||
* sem_ch3.adb: Code clean up.
|
||||
* binderr.ads: Minor comment correction.
|
||||
|
||||
2014-07-31 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_disp.adb (Expand_Interface_Conversion): A call whose
|
||||
prefix is a static conversion to an interface type that is not
|
||||
class-wide is not dispatching.
|
||||
|
||||
2014-07-31 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* inline.adb, s-traceb.adb, s-traceb-hpux.adb, memtrack.adb,
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2014, 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- --
|
||||
|
|
@ -509,12 +509,8 @@ package body Ada.Numerics.Generic_Elementary_Functions is
|
|||
|
||||
function Cos (X : Float_Type'Base) return Float_Type'Base is
|
||||
begin
|
||||
if X = 0.0 then
|
||||
if abs X < Sqrt_Epsilon then
|
||||
return 1.0;
|
||||
|
||||
elsif abs X < Sqrt_Epsilon then
|
||||
return 1.0;
|
||||
|
||||
end if;
|
||||
|
||||
return Float_Type'Base (Aux.Cos (Double (X)));
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2014, 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- --
|
||||
|
|
@ -59,7 +59,7 @@ package Binderr is
|
|||
-- specified by the File_Name_Type value stored in Error_Msg_File_2.
|
||||
|
||||
-- Insertion character $ (Dollar: insert unit name from Names table)
|
||||
-- The character & is replaced by the text for the unit name specified
|
||||
-- The character $ is replaced by the text for the unit name specified
|
||||
-- by the Name_Id value stored in Error_Msg_Unit_1. The name is always
|
||||
-- enclosed in quotes. A second $ may appear in a single message in
|
||||
-- which case it is similarly replaced by the name which is specified
|
||||
|
|
|
|||
|
|
@ -4589,9 +4589,9 @@ package body Exp_Ch3 is
|
|||
-- Expand_Record_Extension is called directly from the semantics, so
|
||||
-- we must check to see whether expansion is active before proceeding
|
||||
-- Because this affects the visibility of selected components in bodies
|
||||
-- of instances, it must also be called in ASIS mode.
|
||||
-- of instances.
|
||||
|
||||
if not (Expander_Active or ASIS_Mode) then
|
||||
if not Expander_Active then
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
|
|
|||
|
|
@ -1191,6 +1191,19 @@ package body Exp_Disp is
|
|||
end if;
|
||||
|
||||
return;
|
||||
|
||||
-- A static conversion to an interface type that is not classwide is
|
||||
-- curious but legal if the interface operation is a null procedure.
|
||||
-- If the operation is abstract it will be rejected later.
|
||||
|
||||
elsif Is_Static
|
||||
and then Is_Interface (Etype (N))
|
||||
and then not Is_Class_Wide_Type (Etype (N))
|
||||
and then Comes_From_Source (N)
|
||||
then
|
||||
Rewrite (N, Unchecked_Convert_To (Etype (N), N));
|
||||
Analyze (N);
|
||||
return;
|
||||
end if;
|
||||
|
||||
if not Is_Static then
|
||||
|
|
|
|||
|
|
@ -147,10 +147,10 @@ begin
|
|||
Temp_File : Boolean;
|
||||
|
||||
begin
|
||||
-- We always analyze config files with style checks off, since
|
||||
-- we don't want a miscellaneous gnat.adc that is around to
|
||||
-- discombobulate intended -gnatg or -gnaty compilations. We
|
||||
-- also disconnect checking for maximum line length.
|
||||
-- We always analyze config files with style checks off, since we
|
||||
-- don't want a miscellaneous gnat.adc that is around to discombobulate
|
||||
-- intended -gnatg or -gnaty compilations. We also disconnect checking
|
||||
-- for maximum line length.
|
||||
|
||||
Opt.Style_Check := False;
|
||||
Style_Check := False;
|
||||
|
|
|
|||
|
|
@ -197,7 +197,7 @@ package body Ch13 is
|
|||
-- The aspect mark is not recognized
|
||||
|
||||
if A_Id = No_Aspect then
|
||||
Error_Msg_SC ("aspect identifier expected");
|
||||
Error_Msg_N ("& is not a valid aspect identifier", Token_Node);
|
||||
OK := False;
|
||||
|
||||
-- Check bad spelling
|
||||
|
|
@ -205,8 +205,8 @@ package body Ch13 is
|
|||
for J in Aspect_Id_Exclude_No_Aspect loop
|
||||
if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
|
||||
Error_Msg_Name_1 := Aspect_Names (J);
|
||||
Error_Msg_SC -- CODEFIX
|
||||
("\possible misspelling of%");
|
||||
Error_Msg_N -- CODEFIX
|
||||
("\possible misspelling of%", Token_Node);
|
||||
exit;
|
||||
end if;
|
||||
end loop;
|
||||
|
|
@ -225,9 +225,13 @@ package body Ch13 is
|
|||
Scan; -- past arrow
|
||||
Set_Expression (Aspect, P_Expression);
|
||||
|
||||
-- The aspect may behave as a boolean aspect
|
||||
-- If we have a correct terminator (comma or semicolon, or a
|
||||
-- reasonable likely missing comma), then just proceed.
|
||||
|
||||
elsif Token = Tok_Comma then
|
||||
elsif Token = Tok_Comma or else
|
||||
Token = Tok_Semicolon or else
|
||||
Token = Tok_Identifier
|
||||
then
|
||||
null;
|
||||
|
||||
-- Otherwise the aspect contains a junk definition
|
||||
|
|
@ -480,24 +484,61 @@ package body Ch13 is
|
|||
if OK then
|
||||
Append (Aspect, Aspects);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- The aspect specification list contains more than one aspect
|
||||
-- Merge here after good or bad aspect (we should be at a comma
|
||||
-- or a semicolon, but there might be other possible errors).
|
||||
|
||||
if Token = Tok_Comma then
|
||||
Scan; -- past comma
|
||||
goto Continue;
|
||||
-- The aspect specification list contains more than one aspect
|
||||
|
||||
-- Check for a missing comma between two aspects. Emit an error
|
||||
-- and proceed to the next aspect.
|
||||
if Token = Tok_Comma then
|
||||
Scan; -- past comma
|
||||
goto Continue;
|
||||
|
||||
elsif Token = Tok_Identifier
|
||||
and then Get_Aspect_Id (Token_Name) /= No_Aspect
|
||||
then
|
||||
declare
|
||||
Scan_State : Saved_Scan_State;
|
||||
-- Check for a missing comma between two aspects. Emit an error
|
||||
-- and proceed to the next aspect.
|
||||
|
||||
begin
|
||||
Save_Scan_State (Scan_State);
|
||||
elsif Token = Tok_Identifier
|
||||
and then Get_Aspect_Id (Token_Name) /= No_Aspect
|
||||
then
|
||||
declare
|
||||
Scan_State : Saved_Scan_State;
|
||||
|
||||
begin
|
||||
Save_Scan_State (Scan_State);
|
||||
Scan; -- past identifier
|
||||
|
||||
-- Attempt to detect ' or => following a potential aspect
|
||||
-- mark.
|
||||
|
||||
if Token = Tok_Apostrophe or else Token = Tok_Arrow then
|
||||
Restore_Scan_State (Scan_State);
|
||||
Error_Msg_AP -- CODEFIX
|
||||
("|missing "",""");
|
||||
goto Continue;
|
||||
|
||||
-- The construct following the current aspect is not an
|
||||
-- aspect.
|
||||
|
||||
else
|
||||
Restore_Scan_State (Scan_State);
|
||||
end if;
|
||||
end;
|
||||
|
||||
-- Check for a mistyped semicolon in place of a comma between two
|
||||
-- aspects. Emit an error and proceed to the next aspect.
|
||||
|
||||
elsif Token = Tok_Semicolon then
|
||||
declare
|
||||
Scan_State : Saved_Scan_State;
|
||||
|
||||
begin
|
||||
Save_Scan_State (Scan_State);
|
||||
Scan; -- past semicolon
|
||||
|
||||
if Token = Tok_Identifier
|
||||
and then Get_Aspect_Id (Token_Name) /= No_Aspect
|
||||
then
|
||||
Scan; -- past identifier
|
||||
|
||||
-- Attempt to detect ' or => following a potential aspect
|
||||
|
|
@ -505,64 +546,30 @@ package body Ch13 is
|
|||
|
||||
if Token = Tok_Apostrophe or else Token = Tok_Arrow then
|
||||
Restore_Scan_State (Scan_State);
|
||||
Error_Msg_AP -- CODEFIX
|
||||
("|missing "",""");
|
||||
Error_Msg_SC -- CODEFIX
|
||||
("|"";"" should be "",""");
|
||||
Scan; -- past semicolon
|
||||
goto Continue;
|
||||
|
||||
-- The construct following the current aspect is not an
|
||||
-- aspect.
|
||||
|
||||
else
|
||||
Restore_Scan_State (Scan_State);
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Check for a mistyped semicolon in place of a comma between two
|
||||
-- aspects. Emit an error and proceed to the next aspect.
|
||||
-- The construct following the current aspect is not an
|
||||
-- aspect.
|
||||
|
||||
elsif Token = Tok_Semicolon then
|
||||
declare
|
||||
Scan_State : Saved_Scan_State;
|
||||
|
||||
begin
|
||||
Save_Scan_State (Scan_State);
|
||||
Scan; -- past semicolon
|
||||
|
||||
if Token = Tok_Identifier
|
||||
and then Get_Aspect_Id (Token_Name) /= No_Aspect
|
||||
then
|
||||
Scan; -- past identifier
|
||||
|
||||
-- Attempt to detect ' or => following a potential aspect
|
||||
-- mark.
|
||||
|
||||
if Token = Tok_Apostrophe or else Token = Tok_Arrow then
|
||||
Restore_Scan_State (Scan_State);
|
||||
Error_Msg_SC -- CODEFIX
|
||||
("|"";"" should be "",""");
|
||||
Scan; -- past semicolon
|
||||
goto Continue;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- The construct following the current aspect is not an
|
||||
-- aspect.
|
||||
|
||||
Restore_Scan_State (Scan_State);
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Must be terminator character
|
||||
|
||||
if Semicolon then
|
||||
T_Semicolon;
|
||||
end if;
|
||||
|
||||
exit;
|
||||
|
||||
<<Continue>>
|
||||
null;
|
||||
Restore_Scan_State (Scan_State);
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Must be terminator character
|
||||
|
||||
if Semicolon then
|
||||
T_Semicolon;
|
||||
end if;
|
||||
|
||||
exit;
|
||||
|
||||
<<Continue>>
|
||||
null;
|
||||
end loop;
|
||||
|
||||
return Aspects;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2014, 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- --
|
||||
|
|
@ -947,12 +947,6 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
|
|||
-- for aspects so it does not matter whether the aspect specifications
|
||||
-- are terminated by semicolon or some other character.
|
||||
|
||||
function Get_Aspect_Specifications
|
||||
(Semicolon : Boolean := True) return List_Id;
|
||||
-- Parse a list of aspects but do not attach them to a declaration node.
|
||||
-- Subsidiary to the following procedure. Used when parsing a subprogram
|
||||
-- specification that may be a declaration or a body.
|
||||
|
||||
procedure P_Aspect_Specifications
|
||||
(Decl : Node_Id;
|
||||
Semicolon : Boolean := True);
|
||||
|
|
@ -977,6 +971,13 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
|
|||
-- are also ignored, but no error message is given (this is used when
|
||||
-- the caller has already taken care of the error message).
|
||||
|
||||
function Get_Aspect_Specifications
|
||||
(Semicolon : Boolean := True) return List_Id;
|
||||
-- Parse a list of aspects but do not attach them to a declaration node.
|
||||
-- Subsidiary to P_Aspect_Specifications procedure. Used when parsing
|
||||
-- a subprogram specification that may be a declaration or a body.
|
||||
-- Semicolon has the same meaning as for P_Aspect_Specifications above.
|
||||
|
||||
function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id;
|
||||
-- Function to parse a code statement. The caller has scanned out
|
||||
-- the name to be used as the subtype mark (but has not checked that
|
||||
|
|
|
|||
|
|
@ -1268,7 +1268,6 @@ package body Sem is
|
|||
Next => Suppress_Stack_Entries);
|
||||
Suppress_Stack_Entries := Global_Suppress_Stack_Top;
|
||||
return;
|
||||
|
||||
end Push_Global_Suppress_Stack_Entry;
|
||||
|
||||
-------------------------------------
|
||||
|
|
|
|||
|
|
@ -12067,11 +12067,24 @@ package body Sem_Ch13 is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- Case of component size is greater than or equal to 64 and the
|
||||
-- alignment of the array is at least as large as the alignment
|
||||
-- of the component. We are definitely OK in this situation.
|
||||
|
||||
if Known_Component_Size (Atyp)
|
||||
and then Component_Size (Atyp) >= 64
|
||||
and then Known_Alignment (Atyp)
|
||||
and then Known_Alignment (Ctyp)
|
||||
and then Alignment (Atyp) >= Alignment (Ctyp)
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Check actual component size
|
||||
|
||||
if not Known_Component_Size (Atyp)
|
||||
or else not (Addressable (Component_Size (Atyp))
|
||||
and then Component_Size (Atyp) < 64)
|
||||
and then Component_Size (Atyp) < 64)
|
||||
or else Component_Size (Atyp) mod Esize (Ctyp) /= 0
|
||||
then
|
||||
No_Independence;
|
||||
|
|
|
|||
|
|
@ -3503,6 +3503,7 @@ package body Sem_Ch3 is
|
|||
and then Nkind (E) = N_Aggregate
|
||||
then
|
||||
Set_Etype (E, T);
|
||||
|
||||
else
|
||||
Resolve (E, T);
|
||||
end if;
|
||||
|
|
@ -8407,9 +8408,16 @@ package body Sem_Ch3 is
|
|||
|
||||
elsif not Private_Extension then
|
||||
|
||||
-- Add the _parent field in the derived type
|
||||
-- Add the _parent field in the derived type. In ASIS mode there is
|
||||
-- not enough semantic information for full expansion, but set the
|
||||
-- parent subtype to allow resolution of selected components in
|
||||
-- instance bodies.
|
||||
|
||||
Expand_Record_Extension (Derived_Type, Type_Def);
|
||||
if ASIS_Mode then
|
||||
Set_Parent_Subtype (Derived_Type, Parent_Type);
|
||||
else
|
||||
Expand_Record_Extension (Derived_Type, Type_Def);
|
||||
end if;
|
||||
|
||||
-- Ada 2005 (AI-251): Addition of the Tag corresponding to all the
|
||||
-- implemented interfaces if we are in expansion mode
|
||||
|
|
|
|||
|
|
@ -106,7 +106,7 @@ package body Sem_Ch6 is
|
|||
procedure Analyze_Null_Procedure
|
||||
(N : Node_Id;
|
||||
Is_Completion : out Boolean);
|
||||
-- A null procedure can be a declaration or (Ada 2012) a completion.
|
||||
-- A null procedure can be a declaration or (Ada 2012) a completion
|
||||
|
||||
procedure Analyze_Return_Statement (N : Node_Id);
|
||||
-- Common processing for simple and extended return statements
|
||||
|
|
@ -1310,12 +1310,16 @@ package body Sem_Ch6 is
|
|||
-- Create new entities for body and formals
|
||||
|
||||
Set_Defining_Unit_Name (Specification (Null_Body),
|
||||
Make_Defining_Identifier (Loc, Chars (Defining_Entity (N))));
|
||||
Make_Defining_Identifier
|
||||
(Sloc (Defining_Entity (N)),
|
||||
Chars (Defining_Entity (N))));
|
||||
|
||||
Form := First (Parameter_Specifications (Specification (Null_Body)));
|
||||
while Present (Form) loop
|
||||
Set_Defining_Identifier (Form,
|
||||
Make_Defining_Identifier (Loc, Chars (Defining_Identifier (Form))));
|
||||
Make_Defining_Identifier
|
||||
(Sloc (Defining_Identifier (Form)),
|
||||
Chars (Defining_Identifier (Form))));
|
||||
Next (Form);
|
||||
end loop;
|
||||
|
||||
|
|
|
|||
|
|
@ -88,8 +88,8 @@ package Sem_Util is
|
|||
function Addressable (V : Uint) return Boolean;
|
||||
function Addressable (V : Int) return Boolean;
|
||||
pragma Inline (Addressable);
|
||||
-- Returns True if the value of V is the word size of an addressable
|
||||
-- factor of the word size (typically 8, 16, 32 or 64).
|
||||
-- Returns True if the value of V is the word size or an addressable factor
|
||||
-- of the word size (typically 8, 16, 32 or 64).
|
||||
|
||||
procedure Aggregate_Constraint_Checks
|
||||
(Exp : Node_Id;
|
||||
|
|
|
|||
Loading…
Reference in New Issue