+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,
-- --
-- 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- --
function Cos (X : Float_Type'Base) return Float_Type'Base is
begin
- if X = 0.0 then
- return 1.0;
-
- elsif abs X < Sqrt_Epsilon then
+ if abs X < Sqrt_Epsilon then
return 1.0;
-
end if;
return Float_Type'Base (Aux.Cos (Double (X)));
-- --
-- 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- --
-- 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
-- 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;
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
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;
-- 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
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;
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
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);
- Scan; -- past identifier
+ elsif Token = Tok_Identifier
+ and then Get_Aspect_Id (Token_Name) /= No_Aspect
+ then
+ declare
+ Scan_State : Saved_Scan_State;
- -- Attempt to detect ' or => following a potential aspect
- -- mark.
+ begin
+ Save_Scan_State (Scan_State);
+ Scan; -- past identifier
- if Token = Tok_Apostrophe or else Token = Tok_Arrow then
- Restore_Scan_State (Scan_State);
- Error_Msg_AP -- CODEFIX
- ("|missing "",""");
- goto Continue;
+ -- Attempt to detect ' or => following a potential aspect
+ -- mark.
- -- The construct following the current aspect is not an
- -- aspect.
+ if Token = Tok_Apostrophe or else Token = Tok_Arrow then
+ Restore_Scan_State (Scan_State);
+ Error_Msg_AP -- CODEFIX
+ ("|missing "",""");
+ goto Continue;
- else
- Restore_Scan_State (Scan_State);
- end if;
- end;
+ -- The construct following the current aspect is not an
+ -- aspect.
- -- Check for a mistyped semicolon in place of a comma between two
- -- aspects. Emit an error and proceed to the next aspect.
+ else
+ Restore_Scan_State (Scan_State);
+ end if;
+ end;
- elsif Token = Tok_Semicolon then
- declare
- Scan_State : Saved_Scan_State;
+ -- Check for a mistyped semicolon in place of a comma between two
+ -- aspects. Emit an error and proceed to the next aspect.
- begin
- Save_Scan_State (Scan_State);
- Scan; -- past semicolon
+ elsif Token = Tok_Semicolon then
+ declare
+ Scan_State : Saved_Scan_State;
- if Token = Tok_Identifier
- and then Get_Aspect_Id (Token_Name) /= No_Aspect
- then
- Scan; -- past identifier
+ begin
+ Save_Scan_State (Scan_State);
+ Scan; -- past semicolon
- -- Attempt to detect ' or => following a potential aspect
- -- mark.
+ if Token = Tok_Identifier
+ and then Get_Aspect_Id (Token_Name) /= No_Aspect
+ then
+ Scan; -- past identifier
- 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;
+ -- 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.
+ -- The construct following the current aspect is not an
+ -- aspect.
- Restore_Scan_State (Scan_State);
- end;
- end if;
+ Restore_Scan_State (Scan_State);
+ end;
+ end if;
- -- Must be terminator character
+ -- Must be terminator character
- if Semicolon then
- T_Semicolon;
- end if;
+ if Semicolon then
+ T_Semicolon;
+ end if;
- exit;
+ exit;
- <<Continue>>
- null;
- end if;
+ <<Continue>>
+ null;
end loop;
return Aspects;
-- --
-- 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- --
-- 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);
-- 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
Next => Suppress_Stack_Entries);
Suppress_Stack_Entries := Global_Suppress_Stack_Top;
return;
-
end Push_Global_Suppress_Stack_Entry;
-------------------------------------
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;
and then Nkind (E) = N_Aggregate
then
Set_Etype (E, T);
+
else
Resolve (E, T);
end if;
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
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
-- 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;
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;
projects / thirdparty / gcc.git / commitdiff
