mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-06 04:00:25 +08:00
[multiple changes]
2014-02-06 Robert Dewar <dewar@adacore.com> * casing.adb (Determine_Casing): Consider SPARK_Mode to be mixed case. 2014-02-06 Ed Schonberg <schonberg@adacore.com> * exp_ch6.adb (Is_Build_In_Place_Function): Predicate is false when the function has a foreign convention, but not if only the limited return type has such a convention. 2014-02-06 Hristian Kirtchev <kirtchev@adacore.com> * sem_ch3.adb (Handle_Late_Controlled_Primitive): Remove local variable Spec. Comment reformatting. Use Copy_Separate_Tree rather than New_Copy_Tree when building the corresponding subprogram declaration. 2014-02-06 Hristian Kirtchev <kirtchev@adacore.com> * sem_prag.adb (Analyze_Global_Item): Remove the mode-related checks on abstract states with enabled external properties. (Property_Error): Removed. 2014-02-06 Javier Miranda <miranda@adacore.com> * lib-xref.adb (Generate_Reference): When generating the reference to the first private entity take care of handling swapped entities. From-SVN: r207547
This commit is contained in:
Arnaud Charlet
parent
e09a559856
commit
4446a13faa
@ -1,3 +1,34 @@
|
||||
2014-02-06 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* casing.adb (Determine_Casing): Consider SPARK_Mode to be
|
||||
mixed case.
|
||||
|
||||
2014-02-06 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_ch6.adb (Is_Build_In_Place_Function): Predicate is false
|
||||
when the function has a foreign convention, but not if only the
|
||||
limited return type has such a convention.
|
||||
|
||||
2014-02-06 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Handle_Late_Controlled_Primitive): Remove local
|
||||
variable Spec. Comment reformatting. Use Copy_Separate_Tree
|
||||
rather than New_Copy_Tree when building the corresponding
|
||||
subprogram declaration.
|
||||
|
||||
2014-02-06 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sem_prag.adb (Analyze_Global_Item): Remove
|
||||
the mode-related checks on abstract states with enabled external
|
||||
properties.
|
||||
(Property_Error): Removed.
|
||||
|
||||
2014-02-06 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* lib-xref.adb (Generate_Reference): When
|
||||
generating the reference to the first private entity take care
|
||||
of handling swapped entities.
|
||||
|
||||
2014-02-06 Sergey Rybin <rybin@adacore.com frybin>
|
||||
|
||||
* gnat_ugn.texi, vms_data.ads: Add documentation of -j option for
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009 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 --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -59,6 +59,14 @@ package body Casing is
|
||||
-- True at start of string, and after an underline character
|
||||
|
||||
begin
|
||||
-- A special kludge, consider SPARK_Mode to be mixed case
|
||||
|
||||
if Ident = "SPARK_Mode" then
|
||||
return Mixed_Case;
|
||||
end if;
|
||||
|
||||
-- Proceed with normal determination
|
||||
|
||||
for S in Ident'Range loop
|
||||
if Ident (S) = '_' or else Ident (S) = '.' then
|
||||
After_Und := True;
|
||||
|
||||
@ -9592,13 +9592,13 @@ package body Exp_Ch6 is
|
||||
or else (Ekind (E) = E_Subprogram_Type
|
||||
and then Etype (E) /= Standard_Void_Type)
|
||||
then
|
||||
-- Note: If you have Convention (C) on an inherently limited type,
|
||||
-- you're on your own. That is, the C code will have to be carefully
|
||||
-- written to know about the Ada conventions.
|
||||
-- Note: If the function has a foreign convention, it cannot build
|
||||
-- its result in place, so you're on your own. On the other hand,
|
||||
-- if only the return type has a foreign convention, its layout is
|
||||
-- intended to be compatible with the other language, but the build-
|
||||
-- in place machinery can ensure that the object is not copied.
|
||||
|
||||
if Has_Foreign_Convention (E)
|
||||
or else Has_Foreign_Convention (Etype (E))
|
||||
then
|
||||
if Has_Foreign_Convention (E) then
|
||||
return False;
|
||||
|
||||
-- In Ada 2005 all functions with an inherently limited return type
|
||||
|
||||
@ -1088,15 +1088,29 @@ package body Lib.Xref is
|
||||
and then Present (First_Private_Entity (E))
|
||||
and then In_Extended_Main_Source_Unit (N)
|
||||
then
|
||||
Add_Entry
|
||||
((Ent => Ent,
|
||||
Loc => Sloc (First_Private_Entity (E)),
|
||||
Typ => 'E',
|
||||
Eun => Get_Source_Unit (Def),
|
||||
Lun => Get_Source_Unit (Ref),
|
||||
Ref_Scope => Empty,
|
||||
Ent_Scope => Empty),
|
||||
Ent_Scope_File => No_Unit);
|
||||
-- Handle case in which the full-view and partial-view of the
|
||||
-- first private entity are swapped
|
||||
|
||||
declare
|
||||
First_Private : Entity_Id := First_Private_Entity (E);
|
||||
|
||||
begin
|
||||
if Is_Private_Type (First_Private)
|
||||
and then Present (Full_View (First_Private))
|
||||
then
|
||||
First_Private := Full_View (First_Private);
|
||||
end if;
|
||||
|
||||
Add_Entry
|
||||
((Ent => Ent,
|
||||
Loc => Sloc (First_Private),
|
||||
Typ => 'E',
|
||||
Eun => Get_Source_Unit (Def),
|
||||
Lun => Get_Source_Unit (Ref),
|
||||
Ref_Scope => Empty,
|
||||
Ent_Scope => Empty),
|
||||
Ent_Scope_File => No_Unit);
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
@ -2110,7 +2110,6 @@ package body Sem_Ch3 is
|
||||
Loc : constant Source_Ptr := Sloc (Body_Id);
|
||||
Params : constant List_Id :=
|
||||
Parameter_Specifications (Body_Spec);
|
||||
Spec : Node_Id;
|
||||
Spec_Id : Entity_Id;
|
||||
|
||||
Dummy : Entity_Id;
|
||||
@ -2119,8 +2118,8 @@ package body Sem_Ch3 is
|
||||
-- spec analysis.
|
||||
|
||||
begin
|
||||
-- Consider only procedure bodies whose name matches one of type
|
||||
-- [Limited_]Controlled's primitives.
|
||||
-- Consider only procedure bodies whose name matches one of the three
|
||||
-- controlled primitives.
|
||||
|
||||
if Nkind (Body_Spec) /= N_Procedure_Specification
|
||||
or else not Nam_In (Chars (Body_Id), Name_Adjust,
|
||||
@ -2129,8 +2128,7 @@ package body Sem_Ch3 is
|
||||
then
|
||||
return;
|
||||
|
||||
-- A controlled primitive must have exactly one formal whose type
|
||||
-- derives from [Limited_]Controlled.
|
||||
-- A controlled primitive must have exactly one formal
|
||||
|
||||
elsif List_Length (Params) /= 1 then
|
||||
return;
|
||||
@ -2138,6 +2136,8 @@ package body Sem_Ch3 is
|
||||
|
||||
Dummy := Analyze_Subprogram_Specification (Body_Spec);
|
||||
|
||||
-- The type of the formal must be derived from [Limited_]Controlled
|
||||
|
||||
if not Is_Controlled (Etype (Defining_Entity (First (Params)))) then
|
||||
return;
|
||||
end if;
|
||||
@ -2152,16 +2152,13 @@ package body Sem_Ch3 is
|
||||
end if;
|
||||
|
||||
-- At this point the body is known to be a late controlled primitive.
|
||||
-- Generate a matching spec and insert it before the body.
|
||||
|
||||
Spec := New_Copy_Tree (Body_Spec);
|
||||
|
||||
Set_Defining_Unit_Name
|
||||
(Spec, Make_Defining_Identifier (Loc, Chars (Body_Id)));
|
||||
-- Generate a matching spec and insert it before the body. Note the
|
||||
-- use of Copy_Separate_Tree - we want an entirely separate semantic
|
||||
-- tree in this case.
|
||||
|
||||
Insert_Before_And_Analyze (Body_Decl,
|
||||
Make_Subprogram_Declaration (Loc,
|
||||
Specification => Spec));
|
||||
Specification => Copy_Separate_Tree (Body_Spec)));
|
||||
end Handle_Late_Controlled_Primitive;
|
||||
|
||||
--------------------------------
|
||||
|
||||
@ -1912,34 +1912,8 @@ package body Sem_Prag is
|
||||
(Item : Node_Id;
|
||||
Global_Mode : Name_Id)
|
||||
is
|
||||
procedure Property_Error
|
||||
(State_Id : Entity_Id;
|
||||
Prop_Nam : Name_Id);
|
||||
-- Emit an error concerning state State_Id with enabled property
|
||||
-- Async_Readers, Effective_Reads or Effective_Writes that is not
|
||||
-- marked as In_Out or Output item.
|
||||
|
||||
--------------------
|
||||
-- Property_Error --
|
||||
--------------------
|
||||
|
||||
procedure Property_Error
|
||||
(State_Id : Entity_Id;
|
||||
Prop_Nam : Name_Id)
|
||||
is
|
||||
begin
|
||||
Error_Msg_Name_1 := Prop_Nam;
|
||||
Error_Msg_NE
|
||||
("external state & with enabled property % must have mode "
|
||||
& "In_Out or Output (SPARK RM 7.1.2(7))", Item, State_Id);
|
||||
end Property_Error;
|
||||
|
||||
-- Local variables
|
||||
|
||||
Item_Id : Entity_Id;
|
||||
|
||||
-- Start of processing for Analyze_Global_Item
|
||||
|
||||
begin
|
||||
-- Detect one of the following cases
|
||||
|
||||
@ -2018,30 +1992,6 @@ package body Sem_Prag is
|
||||
Ref => Item);
|
||||
end if;
|
||||
|
||||
-- Detect an external state with an enabled property that
|
||||
-- does not match the mode of the state.
|
||||
|
||||
if Global_Mode = Name_Input then
|
||||
if Async_Readers_Enabled (Item_Id) then
|
||||
Property_Error (Item_Id, Name_Async_Readers);
|
||||
|
||||
elsif Effective_Reads_Enabled (Item_Id) then
|
||||
Property_Error (Item_Id, Name_Effective_Reads);
|
||||
|
||||
elsif Effective_Writes_Enabled (Item_Id) then
|
||||
Property_Error (Item_Id, Name_Effective_Writes);
|
||||
end if;
|
||||
|
||||
elsif Global_Mode = Name_Output
|
||||
and then Async_Writers_Enabled (Item_Id)
|
||||
then
|
||||
Error_Msg_Name_1 := Name_Async_Writers;
|
||||
Error_Msg_NE
|
||||
("external state & with enabled property % must have "
|
||||
& "mode Input or In_Out (SPARK RM 7.1.2(7))",
|
||||
Item, Item_Id);
|
||||
end if;
|
||||
|
||||
-- Variable related checks
|
||||
|
||||
else
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user