2009-05-06 Robert Dewar <dewar@adacore.com>

	* sem_warn.adb: Minor reformatting

2009-05-06  Javier Miranda  <miranda@adacore.com>

	* sem_prag.adb (Process_Import_Or_Interface): Imported CPP types must
	not have discriminants or components with default expressions.
	(Analyze_Pragma): For pragma CPP_Class check that imported types
	have no discriminants and components have no default expression.

	* sem_aggr.adb (Resolve_Aggr_Expr): Add missing check on wrong use of
	class-wide types in the expression of a record component association.

2009-05-06  Sergey Rybin  <rybin@adacore.com>

	* vms_data.ads: Add qualifier for gnatmetric extra exit points metric

	* gnat_ugn.texi: Add description for the new extra exit points metric
	(gnatmetric section).



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@147170 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 147 insertions, 7 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c92aaf54ab5..0256492af90 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,26 @@
 2009-05-06  Robert Dewar  <dewar@adacore.com>
 
+	* sem_warn.adb: Minor reformatting
+
+2009-05-06  Javier Miranda  <miranda@adacore.com>
+
+	* sem_prag.adb (Process_Import_Or_Interface): Imported CPP types must
+	not have discriminants or components with default expressions.
+	(Analyze_Pragma): For pragma CPP_Class check that imported types
+	have no discriminants and components have no default expression.
+
+	* sem_aggr.adb (Resolve_Aggr_Expr): Add missing check on wrong use of
+	class-wide types in the expression of a record component association.
+
+2009-05-06  Sergey Rybin  <rybin@adacore.com>
+
+	* vms_data.ads: Add qualifier for gnatmetric extra exit points metric
+
+	* gnat_ugn.texi: Add description for the new extra exit points metric
+	(gnatmetric section).
+
+2009-05-06  Robert Dewar  <dewar@adacore.com>
+
 	* s-fileio.adb: Minor comment update
 
 	* sem_ch8.adb: Minor reformatting
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 10ca8ff7cc0..e035ec6996c 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -14,7 +14,7 @@
 @setfilename gnat_ugn.info
 
 @copying
-Copyright @copyright{} 1995-2005, 2006, 2007, 2008 Free Software Foundation,
+Copyright @copyright{} 1995-2009 Free Software Foundation,
 Inc.
 
 Permission is granted to copy, distribute and/or modify this document
@@ -17636,6 +17636,11 @@ bodies, task bodies, entry bodies and statement sequences in package bodies
 Do not consider @code{exit} statements as @code{goto}s when
 computing Essential Complexity
 
+@item ^--extra-exit-points^/EXTRA_EXIT_POINTS_ON^
+Report the extra exit points for subprogram bodies
+
+@item ^--no-extra-exit-points^/EXTRA_EXIT_POINTS_OFF^
+Do not report the extra exit points for subprogram bodies
 @end table
 
 
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 34ad94f0cd9..2a855b2c9e5 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2785,6 +2785,14 @@ package body Sem_Aggr is
          Check_Non_Static_Context (Expr);
          Check_Unset_Reference (Expr);
 
+         --  Check wrong use of class-wide types
+
+         if Is_Class_Wide_Type (Etype (Expr))
+           and then not Is_CPP_Constructor_Call (Expr)
+         then
+            Error_Msg_N ("dynamically tagged expression not allowed", Expr);
+         end if;
+
          if not Has_Expansion_Delayed (Expr) then
             Aggregate_Constraint_Checks (Expr, Expr_Type);
          end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 926f750405d..6d12b8fe4e7 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -1967,7 +1967,8 @@ package body Sem_Prag is
                              (Chars (Arg), Names (Index1))
                         then
                            Error_Msg_Name_1 := Names (Index1);
-                           Error_Msg_N ("\possible misspelling of%", Arg);
+                           Error_Msg_N -- CODEFIX
+                             ("\possible misspelling of%", Arg);
                            exit;
                         end if;
                      end loop;
@@ -3573,6 +3574,49 @@ package body Sem_Prag is
 
                Set_Is_CPP_Class (Def_Id);
                Set_Is_Limited_Record (Def_Id);
+
+               --  Imported CPP types must not have discriminants (because C++
+               --  classes do not have discriminants).
+
+               if Has_Discriminants (Def_Id) then
+                  Error_Msg_N
+                    ("imported 'C'P'P type cannot have discriminants",
+                     First (Discriminant_Specifications
+                             (Declaration_Node (Def_Id))));
+               end if;
+
+               --  Components of imported CPP types must not have default
+               --  expressions because the constructor (if any) is in the
+               --  C++ side.
+
+               declare
+                  Tdef  : constant Node_Id :=
+                            Type_Definition (Declaration_Node (Def_Id));
+                  Clist : Node_Id;
+                  Comp  : Node_Id;
+
+               begin
+                  if Nkind (Tdef) = N_Record_Definition then
+                     Clist := Component_List (Tdef);
+
+                  else
+                     pragma Assert (Nkind (Tdef) = N_Derived_Type_Definition);
+                     Clist := Component_List (Record_Extension_Part (Tdef));
+                  end if;
+
+                  if Present (Clist) then
+                     Comp := First (Component_Items (Clist));
+                     while Present (Comp) loop
+                        if Present (Expression (Comp)) then
+                           Error_Msg_N
+                             ("component of imported 'C'P'P type cannot have" &
+                              " default expression", Expression (Comp));
+                        end if;
+
+                        Next (Comp);
+                     end loop;
+                  end if;
+               end;
             end if;
 
          else
@@ -4183,7 +4227,7 @@ package body Sem_Prag is
                            Error_Msg_String (1 .. Rnm'Length) :=
                              Name_Buffer (1 .. Name_Len);
                            Error_Msg_Strlen := Rnm'Length;
-                           Error_Msg_N
+                           Error_Msg_N -- CODEFIX
                              ("\possible misspelling of ""~""",
                               Get_Pragma_Arg (Arg));
                            exit;
@@ -4937,7 +4981,7 @@ package body Sem_Prag is
             for PN in First_Pragma_Name .. Last_Pragma_Name loop
                if Is_Bad_Spelling_Of (Pname, PN) then
                   Error_Msg_Name_1 := PN;
-                  Error_Msg_N
+                  Error_Msg_N -- CODEFIX
                     ("\?possible misspelling of %!", Pragma_Identifier (N));
                   exit;
                end if;
@@ -6159,6 +6203,62 @@ package body Sem_Prag is
             Set_Is_CPP_Class      (Typ);
             Set_Is_Limited_Record (Typ);
             Set_Convention        (Typ, Convention_CPP);
+
+            --  Imported CPP types must not have discriminants (because C++
+            --  classes do not have discriminants).
+
+            if Has_Discriminants (Typ) then
+               Error_Msg_N
+                 ("imported 'C'P'P type cannot have discriminants",
+                  First (Discriminant_Specifications
+                          (Declaration_Node (Typ))));
+            end if;
+
+            --  Components of imported CPP types must not have default
+            --  expressions because the constructor (if any) is in the
+            --  C++ side.
+
+            if Is_Incomplete_Or_Private_Type (Typ)
+              and then No (Underlying_Type (Typ))
+            then
+               --  It should be an error to apply pragma CPP to a private
+               --  type if the underlying type is not visible (as it is
+               --  for any representation item). For now, for backward
+               --  compatibility we do nothing but we cannot check components
+               --  because they are not available at this stage. All this code
+               --  will be removed when we cleanup this obsolete GNAT pragma???
+
+               null;
+
+            else
+               declare
+                  Tdef  : constant Node_Id :=
+                            Type_Definition (Declaration_Node (Typ));
+                  Clist : Node_Id;
+                  Comp  : Node_Id;
+
+               begin
+                  if Nkind (Tdef) = N_Record_Definition then
+                     Clist := Component_List (Tdef);
+                  else
+                     pragma Assert (Nkind (Tdef) = N_Derived_Type_Definition);
+                     Clist := Component_List (Record_Extension_Part (Tdef));
+                  end if;
+
+                  if Present (Clist) then
+                     Comp := First (Component_Items (Clist));
+                     while Present (Comp) loop
+                        if Present (Expression (Comp)) then
+                           Error_Msg_N
+                             ("component of imported 'C'P'P type cannot have" &
+                              " default expression", Expression (Comp));
+                        end if;
+
+                        Next (Comp);
+                     end loop;
+                  end if;
+               end;
+            end if;
          end CPP_Class;
 
          ---------------------
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index ec1d1d767e0..eca31f0356c 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -954,8 +954,8 @@ package body Sem_Warn is
                   --  here (note that the dereference may not be explicit in
                   --  the source, for example in the case of a dispatching call
                   --  with an anonymous access controlling formal, or of an
-                  --  assignment of a pointer involving discriminant check
-                  --  on the designated object).
+                  --  assignment of a pointer involving discriminant check on
+                  --  the designated object).
 
                   if not Warnings_Off_E1 then
                      Error_Msg_NE ("?& may be null!", UR, E1);
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index d61a82e5a33..f4841df6df7 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -5116,7 +5116,11 @@ package VMS_Data is
                                               "AVERAGE_COMPLEXITY_ON "     &
                                               "--complexity-average "      &
                                               "AVERAGE_COMPLEXITY_OFF "    &
-                                              "--no-complexity-average";
+                                              "--no-complexity-average "   &
+                                              "EXTRA_EXIT_POINTS_ON "      &
+                                              "--extra-exit-points "       &
+                                              "EXTRA_EXIT_POINTS_OFF "     &
+                                              "--no-extra-exit-points";
    --      /COMPLEXITY_METRICS=(option, option ...)
 
    --   Specifies the complexity metrics to be computed (if at least one
@@ -5139,6 +5143,8 @@ package VMS_Data is
    --                              executable bodies
    --     AVERAGE_COMPLEXITY_OFF   Do not compute the average complexity for
    --                              executable bodies
+   --     EXTRA_EXIT_POINTS_ON     Compute extra exit points metric
+   --     EXTRA_EXIT_POINTS_OFF    Do not compute extra exit points metric
    --
    --   All combinations of line metrics options are allowed.