From: Arnaud Charlet Date: Fri, 10 Oct 2014 14:00:07 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=33b87152da3942dfc8f34c6447a6bfed307fca0e;p=gcc.git [multiple changes] 2014-10-10 Yannick Moy * sem_prag.adb (Analyze_Global_Item): Accept formal objects in Global contracts. * errout.adb, errout.ads (SPARK_Msg_NE): Issue error unless SPARK_Mode is Off. 2014-10-10 Vadim Godunko * a-stwima.adb (To_Sequence): Compute size of result array. 2014-10-10 Javier Miranda * gnat_ugn.texi (Interfacing with C++ at the Class Level): Update the sources of the example to avoid a warning when the Ada files are automatically generated by the binding generator. 2014-10-10 Ed Schonberg * sem_attr.adb (Resolve_Attribute, case 'Update): Set Do_Range_Check on the expression of a record component association when needed, as is done for array components, when the corresponding type is a scalar type. From-SVN: r216084 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b62069f464b..401751c6e99 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2014-10-10 Yannick Moy + + * sem_prag.adb (Analyze_Global_Item): Accept formal objects in Global + contracts. + * errout.adb, errout.ads (SPARK_Msg_NE): Issue error unless + SPARK_Mode is Off. + +2014-10-10 Vadim Godunko + + * a-stwima.adb (To_Sequence): Compute size of result array. + +2014-10-10 Javier Miranda + + * gnat_ugn.texi (Interfacing with C++ at the Class Level): Update the + sources of the example to avoid a warning when the Ada files are + automatically generated by the binding generator. + +2014-10-10 Ed Schonberg + + * sem_attr.adb (Resolve_Attribute, case 'Update): Set + Do_Range_Check on the expression of a record component + association when needed, as is done for array components, when + the corresponding type is a scalar type. + 2014-10-10 Gary Dismukes * a-coinho-shared.adb: Minor typo fix. diff --git a/gcc/ada/a-stwima.adb b/gcc/ada/a-stwima.adb index 5937c7d9ec9..c7ab14f4ac4 100644 --- a/gcc/ada/a-stwima.adb +++ b/gcc/ada/a-stwima.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- 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- -- @@ -567,20 +567,25 @@ package body Ada.Strings.Wide_Maps is function To_Sequence (Set : Wide_Character_Set) return Wide_Character_Sequence is - SS : constant Wide_Character_Ranges_Access := Set.Set; - - Result : Wide_String (Positive range 1 .. 2 ** 16); - N : Natural := 0; + SS : constant Wide_Character_Ranges_Access := Set.Set; + N : Natural := 0; + Count : Natural := 0; begin for J in SS'Range loop - for K in SS (J).Low .. SS (J).High loop - N := N + 1; - Result (N) := K; - end loop; + Count := + Count + (Wide_Character'Pos (SS (J).High) - + Wide_Character'Pos (SS (J).Low) + 1); end loop; - return Result (1 .. N); + return Result : Wide_String (1 .. Count) do + for J in SS'Range loop + for K in SS (J).Low .. SS (J).High loop + N := N + 1; + Result (N) := K; + end loop; + end loop; + end return; end To_Sequence; ------------ diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 78ca1fe2fc4..f26059adbc3 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -3153,7 +3153,7 @@ package body Errout is E : Node_Or_Entity_Id) is begin - if SPARK_Mode = On then + if SPARK_Mode /= Off then Error_Msg_NE (Msg, N, E); end if; end SPARK_Msg_NE; diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 92642daacd4..abde9b435ac 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -876,9 +876,8 @@ package Errout is N : Node_Or_Entity_Id; E : Node_Or_Entity_Id); pragma Inline (SPARK_Msg_NE); - -- Same as Error_Msg_NE, but the error is reported only when SPARK_Mode is - -- "on". The routine is inlined because it acts as a simple wrapper. - -- Is it right that this is so different from SPARK_Msg_N??? + -- Same as Error_Msg_NE, but the error is suppressed if SPARK_Mode is Off. + -- The routine is inlined because it acts as a simple wrapper. ------------------------------------ -- Utility Interface for Back End -- diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index e58a2a90a61..2c6aabd2ff8 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -2960,14 +2960,15 @@ constructors are defined on the C++ side and imported from the Ada side, and latter the reverse case. The root of our derivation will be the @code{Animal} class, with a -single private attribute (the @code{Age} of the animal) and two public -primitives to set and get the value of this attribute. +single private attribute (the @code{Age} of the animal), a constructor, +and two public primitives to set and get the value of this attribute. @smallexample @b{class} Animal @{ @b{public}: @b{virtual} void Set_Age (int New_Age); @b{virtual} int Age (); + Animal() @{Age_Count = 0;@}; @b{private}: int Age_Count; @}; @@ -3013,19 +3014,19 @@ how to import these C++ declarations from the Ada side: @smallexample @c ada @b{with} Interfaces.C.Strings; @b{use} Interfaces.C.Strings; @b{package} Animals @b{is} - @b{type} Carnivore @b{is} interface; + @b{type} Carnivore @b{is} @b{limited} interface; @b{pragma} Convention (C_Plus_Plus, Carnivore); @b{function} Number_Of_Teeth (X : Carnivore) @b{return} Natural @b{is} @b{abstract}; - @b{type} Domestic @b{is} interface; - @b{pragma} Convention (C_Plus_Plus, Set_Owner); + @b{type} Domestic @b{is} @b{limited} interface; + @b{pragma} Convention (C_Plus_Plus, Domestic); @b{procedure} Set_Owner (X : @b{in} @b{out} Domestic; Name : Chars_Ptr) @b{is} @b{abstract}; - @b{type} Animal @b{is} @b{tagged} @b{record} - Age : Natural := 0; + @b{type} Animal @b{is} @b{tagged} @b{limited} @b{record} + Age : Natural; @b{end} @b{record}; @b{pragma} Import (C_Plus_Plus, Animal); @@ -3035,13 +3036,17 @@ how to import these C++ declarations from the Ada side: @b{function} Age (X : Animal) @b{return} Integer; @b{pragma} Import (C_Plus_Plus, Age); + @b{function} New_Animal @b{return} Animal; + @b{pragma} CPP_Constructor (New_Animal); + @b{pragma} Import (CPP, New_Animal, "_ZN6AnimalC1Ev"); + @b{type} Dog @b{is} @b{new} Animal @b{and} Carnivore @b{and} Domestic @b{with} @b{record} Tooth_Count : Natural; Owner : String (1 .. 30); @b{end} @b{record}; @b{pragma} Import (C_Plus_Plus, Dog); - @b{function} Number_Of_Teeth (A : Dog) @b{return} Integer; + @b{function} Number_Of_Teeth (A : Dog) @b{return} Natural; @b{pragma} Import (C_Plus_Plus, Number_Of_Teeth); @b{procedure} Set_Owner (A : @b{in} @b{out} Dog; Name : Chars_Ptr); @@ -3100,19 +3105,19 @@ them to C++, using the same hierarchy of our previous example: @b{with} Interfaces.C.Strings; @b{use} Interfaces.C.Strings; @b{package} Animals @b{is} - @b{type} Carnivore @b{is} interface; + @b{type} Carnivore @b{is} @b{limited} interface; @b{pragma} Convention (C_Plus_Plus, Carnivore); @b{function} Number_Of_Teeth (X : Carnivore) @b{return} Natural @b{is} @b{abstract}; - @b{type} Domestic @b{is} interface; - @b{pragma} Convention (C_Plus_Plus, Set_Owner); + @b{type} Domestic @b{is} @b{limited} interface; + @b{pragma} Convention (C_Plus_Plus, Domestic); @b{procedure} Set_Owner (X : @b{in} @b{out} Domestic; Name : Chars_Ptr) @b{is} @b{abstract}; @b{type} Animal @b{is} @b{tagged} @b{record} - Age : Natural := 0; + Age : Natural; @b{end} @b{record}; @b{pragma} Convention (C_Plus_Plus, Animal); @@ -3122,13 +3127,16 @@ them to C++, using the same hierarchy of our previous example: @b{function} Age (X : Animal) @b{return} Integer; @b{pragma} Export (C_Plus_Plus, Age); + @b{function} New_Animal @b{return} Animal'Class; + @b{pragma} Export (C_Plus_Plus, New_Animal); + @b{type} Dog @b{is} @b{new} Animal @b{and} Carnivore @b{and} Domestic @b{with} @b{record} Tooth_Count : Natural; Owner : String (1 .. 30); @b{end} @b{record}; @b{pragma} Convention (C_Plus_Plus, Dog); - @b{function} Number_Of_Teeth (A : Dog) @b{return} Integer; + @b{function} Number_Of_Teeth (A : Dog) @b{return} Natural; @b{pragma} Export (C_Plus_Plus, Number_Of_Teeth); @b{procedure} Set_Owner (A : @b{in} @b{out} Dog; Name : Chars_Ptr); @@ -3139,7 +3147,8 @@ them to C++, using the same hierarchy of our previous example: @b{end} Animals; @end smallexample -Compared with our previous example the only difference is the use of +Compared with our previous example the only differences are the use of +@code{pragma Convention} (instead of @code{pragma Import}), and the use of @code{pragma Export} to indicate to the GNAT compiler that the primitives will be available to C++. Thanks to the ABI compatibility, on the C++ side there is nothing else to be done; as explained above, the only requirement is that all diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index cdb3cfe33c2..7906041d08b 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -11021,13 +11021,21 @@ package body Sem_Attr is else Assoc := First (Component_Associations (Aggr)); + while Present (Assoc) loop Comp := First (Choices (Assoc)); + Expr := Expression (Assoc); if Nkind (Comp) /= N_Others_Choice and then not Error_Posted (Comp) then - Resolve (Expression (Assoc), Etype (Entity (Comp))); + Resolve (Expr, Etype (Entity (Comp))); + + if Is_Scalar_Type (Etype (Entity (Comp))) + and then not Is_OK_Static_Expression (Expr) + then + Set_Do_Range_Check (Expr); + end if; end if; Next (Assoc); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 436b9b12a29..ec0441961df 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -1977,6 +1977,11 @@ package body Sem_Prag is elsif Ekind (Item_Id) = E_Constant then SPARK_Msg_N ("global item cannot denote a constant", Item); + -- A formal object may act as a global item inside a generic + + elsif Is_Formal_Object (Item_Id) then + null; + -- The only legal references are those to abstract states and -- variables (SPARK RM 6.1.4(4)).