]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Fri, 8 Oct 2010 12:40:25 +0000 (14:40 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Fri, 8 Oct 2010 12:40:25 +0000 (14:40 +0200)
2010-10-08  Robert Dewar  <dewar@adacore.com>

* par-ch3.adb: Minor reformatting.

2010-10-08  Javier Miranda  <miranda@adacore.com>

* exp_disp.adb (Make_DT): Do not generate dispatch tables for CIL/Java
types.

2010-10-08  Robert Dewar  <dewar@adacore.com>

* par-ch8.adb (P_Use_Type_Clause): Recognize ALL keyword in Ada 2012
mode.
* sinfo.adb (Use_Type_Clause): Add All_Present flag.
* sinfo.ads (Use_Type_Clause): Add All_Present flag.
* s-rident.ads: Add entry for No_Allocators_After_Elaboration,
No_Anonymous_Allocators.

2010-10-08  Vincent Celier  <celier@adacore.com>

* bindgen.adb (Gen_Restrictions_Ada): No new line after last
restriction, so that the last comma is always replaced with a left
parenthesis.

2010-10-08  Javier Miranda  <miranda@adacore.com>

* sem_prag.adb (Analyze_Pragma): Add specific check on the type of the
first formal of delegates.

From-SVN: r165169

gcc/ada/ChangeLog
gcc/ada/bindgen.adb
gcc/ada/exp_disp.adb
gcc/ada/par-ch3.adb
gcc/ada/par-ch8.adb
gcc/ada/s-rident.ads
gcc/ada/sem_prag.adb
gcc/ada/sinfo.adb
gcc/ada/sinfo.ads

index 2b37a3cc7dd5f1b46c6ed8c5d720edf290365225..87ee729f41c19e6c449f186b37422bee55d1c1ad 100644 (file)
@@ -1,3 +1,32 @@
+2010-10-08  Robert Dewar  <dewar@adacore.com>
+
+       * par-ch3.adb: Minor reformatting.
+
+2010-10-08  Javier Miranda  <miranda@adacore.com>
+
+       * exp_disp.adb (Make_DT): Do not generate dispatch tables for CIL/Java
+       types.
+
+2010-10-08  Robert Dewar  <dewar@adacore.com>
+
+       * par-ch8.adb (P_Use_Type_Clause): Recognize ALL keyword in Ada 2012
+       mode.
+       * sinfo.adb (Use_Type_Clause): Add All_Present flag.
+       * sinfo.ads (Use_Type_Clause): Add All_Present flag.
+       * s-rident.ads: Add entry for No_Allocators_After_Elaboration,
+       No_Anonymous_Allocators.
+
+2010-10-08  Vincent Celier  <celier@adacore.com>
+
+       * bindgen.adb (Gen_Restrictions_Ada): No new line after last
+       restriction, so that the last comma is always replaced with a left
+       parenthesis.
+
+2010-10-08  Javier Miranda  <miranda@adacore.com>
+
+       * sem_prag.adb (Analyze_Pragma): Add specific check on the type of the
+       first formal of delegates.
+
 2010-10-08  Robert Dewar  <dewar@adacore.com>
 
        * sem_aggr.adb: Minor reformatting.
index cbcc96bbd65dcead67937bb842030b8fb4036d53..ff2498cc768f14d9b79aec0c2ae6f4c55b22ba8f 100644 (file)
@@ -479,9 +479,9 @@ package body Bindgen is
                Set_String (", """);
                Get_Name_String (U.Uname);
 
-               --  In the case of JGNAT we need to emit an Import name
-               --  that includes the class name (using '$' separators
-               --  in the case of a child unit name).
+               --  In the case of JGNAT we need to emit an Import name that
+               --  includes the class name (using '$' separators in the case
+               --  of a child unit name).
 
                if VM_Target /= No_VM then
                   for J in 1 .. Name_Len - 2 loop
@@ -2818,7 +2818,7 @@ package body Bindgen is
          Set_String (", ");
          Count := Count + 1;
 
-         if Count = 8 then
+         if J /= Cumulative_Restrictions.Set'Last and then Count = 8 then
             Write_Statement_Buffer;
             Set_String ("           ");
             Count := 0;
@@ -2845,7 +2845,7 @@ package body Bindgen is
          Set_String (", ");
          Count := Count + 1;
 
-         if Count = 8 then
+         if J /= Cumulative_Restrictions.Set'Last and then Count = 8 then
             Write_Statement_Buffer;
             Set_String ("           ");
             Count := 0;
index af3a0b38536d5bd1f3efefd696efcf6b680082e0..d783cda519ee294523f256295e4773ab3a4b68ff 100644 (file)
@@ -4316,6 +4316,8 @@ package body Exp_Disp is
       if Has_Dispatch_Table (Typ)
         or else No (Access_Disp_Table (Typ))
         or else Is_CPP_Class (Typ)
+        or else Convention (Typ) = Convention_CIL
+        or else Convention (Typ) = Convention_Java
       then
          return Result;
 
index 885ba1e5761488f0abc364c6cec58c3022bb1ed3..ec1f33a67f1ed066977df79bcc10f931a1ddd8b0 100644 (file)
@@ -3677,10 +3677,11 @@ package body Ch3 is
                   --     when (A in 1 .. 10 | 12) =>
                   --     when (A in 1 .. 10) | 12 =>
 
-                  --  To solve this, in Ada 2012 mode, we disallow
-                  --  the use of membership operations in expressions in
-                  --  choices. Technically in the grammar, the expression
-                  --  must match the grammar for restricted expression.
+                  --  To solve this, in Ada 2012 mode, we disallow the use of
+                  --  membership operations in expressions in choices.
+
+                  --  Technically in the grammar, the expression must match the
+                  --  grammar for restricted expression.
 
                   if Ada_Version >= Ada_12 then
                      Check_Restricted_Expression (Expr_Node);
index 888b6d1040274b37d51a27e41bd71deaf3a35020..99c2624dcab52f94a9fd453003b0f2ca691b48ee 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -51,9 +51,8 @@ package body Ch8 is
    begin
       Scan; -- past USE
 
-      if Token = Tok_Type then
+      if Token = Tok_Type or else Token = Tok_All then
          return P_Use_Type_Clause;
-
       else
          return P_Use_Package_Clause;
       end if;
@@ -95,18 +94,35 @@ package body Ch8 is
    -- 8.4  Use Type Clause --
    --------------------------
 
-   --  USE_TYPE_CLAUSE ::= use type SUBTYPE_MARK {, SUBTYPE_MARK};
+   --  USE_TYPE_CLAUSE ::= use [ALL] type SUBTYPE_MARK {, SUBTYPE_MARK};
 
    --  The caller has checked that the initial token is USE, scanned it out
-   --  and that the current token is TYPE.
+   --  and that the current token is either ALL or TYPE.
+
+   --  Note: Use of ALL is an Ada 2012 feature
 
    --  Error recovery: cannot raise Error_Resync
 
    function P_Use_Type_Clause return Node_Id is
-      Use_Node : Node_Id;
+      Use_Node    : Node_Id;
+      All_Present : Boolean;
 
    begin
+      if Token = Tok_All then
+         if Ada_Version < Ada_12 then
+            Error_Msg_SC ("|`USE ALL TYPE` is an Ada 2012 feature");
+            Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
+         end if;
+
+         All_Present := True;
+         Scan; -- past ALL
+
+      else
+         All_Present := False;
+      end if;
+
       Use_Node := New_Node (N_Use_Type_Clause, Prev_Token_Ptr);
+      Set_All_Present (Use_Node, All_Present);
       Set_Subtype_Marks (Use_Node, New_List);
 
       if Ada_Version = Ada_83 then
index 110731f344764f37725b80647f209118194f2017..972a3e83845031f8e53c3f284fb8b00f23359a61 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -62,6 +62,7 @@ package System.Rident is
       No_Abort_Statements,                     -- (RM D.7(5), H.4(3))
       No_Access_Subprograms,                   -- (RM H.4(17))
       No_Allocators,                           -- (RM H.4(7))
+      No_Anonymous_Allocators,                 -- Ada 2012
       No_Asynchronous_Control,                 -- (RM D.7(10))
       No_Calendar,                             -- GNAT
       No_Delay,                                -- (RM H.4(21))
@@ -70,6 +71,7 @@ package System.Rident is
       No_Dispatching_Calls,                    -- GNAT
       No_Dynamic_Attachment,                   -- GNAT
       No_Dynamic_Priorities,                   -- (RM D.9(9))
+      No_Allocators_After_Elaboration,         -- Ada 2012
       No_Enumeration_Maps,                     -- GNAT
       No_Entry_Calls_In_Elaboration_Code,      -- GNAT
       No_Entry_Queue,                          -- GNAT (Ravenscar)
index 30a0a3f0dde73c7c51643f40a38578ef2d5c6887..3a9a48289c2a8d448f8fd03f70e207411156f22c 100644 (file)
@@ -9009,16 +9009,35 @@ package body Sem_Prag is
                        ("first formal of % function must be named `this`",
                         Parent (First_Formal (Def_Id)));
 
+                  elsif not Is_Access_Type (Etype (First_Formal (Def_Id))) then
+                     Error_Msg_Name_1 := Pname;
+                     Error_Msg_N
+                       ("first formal of % function must be an access type",
+                        Parameter_Type (Parent (First_Formal (Def_Id))));
+
+                  --  For delegates the type of the first formal must be a
+                  --  named access-to-subprogram type (see previous example)
+
+                  elsif Ekind (Etype (Def_Id)) = E_Access_Subprogram_Type
+                    and then Ekind (Etype (First_Formal (Def_Id)))
+                               /= E_Access_Subprogram_Type
+                  then
+                     Error_Msg_Name_1 := Pname;
+                     Error_Msg_N
+                       ("first formal of % function must be a named access" &
+                        " to subprogram type",
+                        Parameter_Type (Parent (First_Formal (Def_Id))));
+
                   --  Warning: We should reject anonymous access types because
                   --  the constructor must not be handled as a primitive of the
                   --  tagged type. We temporarily allow it because this profile
                   --  is currently generated by cil2ada???
 
-                  elsif not Is_Access_Type (Etype (First_Formal (Def_Id)))
-                    or else not Ekind_In (Etype (First_Formal (Def_Id)),
-                                  E_Access_Type,
-                                  E_General_Access_Type,
-                                  E_Anonymous_Access_Type) --  ???
+                  elsif Ekind (Etype (Def_Id)) /= E_Access_Subprogram_Type
+                    and then not Ekind_In (Etype (First_Formal (Def_Id)),
+                                   E_Access_Type,
+                                   E_General_Access_Type,
+                                   E_Anonymous_Access_Type)
                   then
                      Error_Msg_Name_1 := Pname;
                      Error_Msg_N
index 45659021e9b747f982e85e17b3050dbef1391f58..cac6e7341b528a9ff256f240b169b636f89696db 100644 (file)
@@ -223,7 +223,8 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Access_Definition
-        or else NT (N).Nkind = N_Access_To_Object_Definition);
+        or else NT (N).Nkind = N_Access_To_Object_Definition
+        or else NT (N).Nkind = N_Use_Type_Clause);
       return Flag15 (N);
    end All_Present;
 
@@ -3137,7 +3138,8 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Access_Definition
-        or else NT (N).Nkind = N_Access_To_Object_Definition);
+        or else NT (N).Nkind = N_Access_To_Object_Definition
+        or else NT (N).Nkind = N_Use_Type_Clause);
       Set_Flag15 (N, Val);
    end Set_All_Present;
 
index 3f4032256227655f11545124e2bcf600d4886a08..df4abd268e98026debf0104605ef091ba299f94a 100644 (file)
@@ -4730,15 +4730,18 @@ package Sinfo is
       -- 8.4  Use Type Clause --
       --------------------------
 
-      --  USE_TYPE_CLAUSE ::= use type SUBTYPE_MARK {, SUBTYPE_MARK};
+      --  USE_TYPE_CLAUSE ::= use [ALL] type SUBTYPE_MARK {, SUBTYPE_MARK};
 
       --  Note: use type clause is not permitted in Ada 83 mode
 
+      --  Note: the ALL keyword can appear only in Ada 2012 mode
+
       --  N_Use_Type_Clause
       --  Sloc points to USE
       --  Subtype_Marks (List2)
       --  Next_Use_Clause (Node3-Sem)
       --  Hidden_By_Use_Clause (Elist4-Sem)
+      --  All_Present (Flag15)
 
       -------------------------------
       -- 8.5  Renaming Declaration --