2011-12-22 Vincent Pucci <pucci@adacore.com>

	* sem_dim.adb: Addressed all ??? comments. Replacement of warnings by
	errors using continuation marks.
	(Error_Dim_Msg_For_?): Renaming of Error_Dim_For_?.

2011-12-22  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, sem_ch3.ads, sem_prag.adb: Minor code clean up.

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d7dd99f..5780f4c 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2011-12-22  Vincent Pucci  <pucci@adacore.com>
+
+       * sem_dim.adb: Addressed all ??? comments. Replacement of warnings by
+       errors using continuation marks.
+       (Error_Dim_Msg_For_?): Renaming of Error_Dim_For_?.
+
+2011-12-22  Robert Dewar  <dewar@adacore.com>
+
+       * sem_ch3.adb, sem_ch3.ads, sem_prag.adb: Minor code clean up.
+
 2011-12-21  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
        * s-oscons-tmplt.c [__alpha__ && __osf__] (_XOPEN_SOURCE): Define.

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 7de6f86..662f7e1 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -9640,37 +9640,39 @@ package body Sem_Ch3 is
       end loop;
    end Check_Completion;
 
-   --------------------
-   -- Check_CPP_Type --
-   --------------------
+   ------------------------------------
+   -- Check_CPP_Type_Has_No_Defaults --
+   ------------------------------------
 
-   procedure Check_CPP_Type (T : Entity_Id) is
+   procedure Check_CPP_Type_Has_No_Defaults (T : Entity_Id) is
       Tdef  : constant Node_Id := Type_Definition (Declaration_Node (T));
       Clist : Node_Id;
       Comp  : Node_Id;
 
    begin
+      --  Obtain the component list
+
       if Nkind (Tdef) = N_Record_Definition then
          Clist := Component_List (Tdef);
-
-      else
-         pragma Assert (Nkind (Tdef) = N_Derived_Type_Definition);
+      else pragma Assert (Nkind (Tdef) = N_Derived_Type_Definition);
          Clist := Component_List (Record_Extension_Part (Tdef));
       end if;
 
+      --  Check all components to ensure no default expressions
+
       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));
+                 ("component of imported 'C'P'P type cannot have "
+                  & "default expression", Expression (Comp));
             end if;
 
             Next (Comp);
          end loop;
       end if;
-   end Check_CPP_Type;
+   end Check_CPP_Type_Has_No_Defaults;
 
    ----------------------------
    -- Check_Delta_Expression --
@@ -18130,7 +18132,7 @@ package body Sem_Ch3 is
          --  Check that components of imported CPP types do not have default
          --  expressions.
 
-         Check_CPP_Type (Full_T);
+         Check_CPP_Type_Has_No_Defaults (Full_T);
       end if;
 
       --  If the private view has user specified stream attributes, then so has

diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads
index 7b4d2a9..a57b65d 100644 (file)
--- a/gcc/ada/sem_ch3.ads
+++ b/gcc/ada/sem_ch3.ads
@@ -115,7 +115,7 @@ package Sem_Ch3 is
    --  and errors are posted on that node, rather than on the declarations that
    --  require completion in the package declaration.
 
-   procedure Check_CPP_Type (T : Entity_Id);
+   procedure Check_CPP_Type_Has_No_Defaults (T : Entity_Id);
    --  Check that components of imported CPP type T do not have default
    --  expressions because the constructor (if any) is on the C++ side.
 

diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index f90fa0a..edb4343 100644 (file)
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -258,7 +258,7 @@ package body Sem_Dim is
    --  Subroutine of Analyze_Dimension for object declaration. Check that
    --  the dimensions of the object type and the dimensions of the expression
    --  (if expression is present) match. Note that when the expression is
-   --  a literal, no warning is returned. This special case allows object
+   --  a literal, no error is returned. This special case allows object
    --  declaration such as: m : constant Length := 1.0;
 
    procedure Analyze_Dimension_Object_Renaming_Declaration (N : Node_Id);
@@ -274,7 +274,7 @@ package body Sem_Dim is
    --  Subroutine of Analyze_Dimension for subtype declaration. Propagate the
    --  dimensions from the parent type to the identifier of N. Note that if
    --  both the identifier and the parent type of N are not dimensionless,
-   --  return an error message.
+   --  return an error.
 
    procedure Analyze_Dimension_Unary_Op (N : Node_Id);
    --  Subroutine of Analyze_Dimension for unary operators. For Plus, Minus and
@@ -1035,26 +1035,33 @@ package body Sem_Dim is
       Rhs         : constant Node_Id := Expression (N);
       Dims_Of_Rhs : constant Dimension_Type := Dimensions_Of (Rhs);
 
-      procedure Error_Dim_For_Assignment_Statement (N, Lhs, Rhs : Node_Id);
-      --  Error using Error_Msg_N at node N. Output in the error message the
-      --  dimensions of left and right hand sides.
-
-      ----------------------------------------
-      -- Error_Dim_For_Assignment_Statement --
-      ----------------------------------------
-
-      procedure Error_Dim_For_Assignment_Statement (N, Lhs, Rhs : Node_Id) is
+      procedure Error_Dim_Msg_For_Assignment_Statement
+        (N   : Node_Id;
+         Lhs : Node_Id;
+         Rhs : Node_Id);
+      --  Error using Error_Msg_N at node N. Output the dimensions of left
+      --  and right hand sides.
+
+      --------------------------------------------
+      -- Error_Dim_Msg_For_Assignment_Statement --
+      --------------------------------------------
+
+      procedure Error_Dim_Msg_For_Assignment_Statement
+        (N   : Node_Id;
+         Lhs : Node_Id;
+         Rhs : Node_Id)
+      is
       begin
-         Error_Msg_N ("?dimensions mismatch in assignment", N);
-         Error_Msg_N ("?left-hand side " & Dimensions_Msg_Of (Lhs), N);
-         Error_Msg_N ("?right-hand side " & Dimensions_Msg_Of (Rhs), N);
-      end Error_Dim_For_Assignment_Statement;
+         Error_Msg_N ("dimensions mismatch in assignment", N);
+         Error_Msg_N ("\left-hand side " & Dimensions_Msg_Of (Lhs), N);
+         Error_Msg_N ("\right-hand side " & Dimensions_Msg_Of (Rhs), N);
+      end Error_Dim_Msg_For_Assignment_Statement;
 
    --  Start of processing for Analyze_Dimension_Assignment
 
    begin
       if Dims_Of_Lhs /= Dims_Of_Rhs then
-         Error_Dim_For_Assignment_Statement (N, Lhs, Rhs);
+         Error_Dim_Msg_For_Assignment_Statement (N, Lhs, Rhs);
       end if;
    end Analyze_Dimension_Assignment_Statement;
 
@@ -1068,23 +1075,23 @@ package body Sem_Dim is
    procedure Analyze_Dimension_Binary_Op (N : Node_Id) is
       N_Kind : constant Node_Kind := Nkind (N);
 
-      procedure Error_Dim_For_Binary_Op (N, L, R : Node_Id);
-      --  Error using Error_Msg_N at node N
-      --  Output in the error message the dimensions of both operands.
+      procedure Error_Dim_Msg_For_Binary_Op (N, L, R : Node_Id);
+      --  Error using Error_Msg_NE and Error_Msg_N at node N. Output the
+      --  dimensions of both operands.
 
-      -----------------------------
-      -- Error_Dim_For_Binary_Op --
-      -----------------------------
+      ---------------------------------
+      -- Error_Dim_Msg_For_Binary_Op --
+      ---------------------------------
 
-      procedure Error_Dim_For_Binary_Op (N, L, R : Node_Id) is
+      procedure Error_Dim_Msg_For_Binary_Op (N, L, R : Node_Id) is
       begin
-         Error_Msg_NE ("?both operands for operation& must have same " &
+         Error_Msg_NE ("both operands for operation& must have same " &
                        "dimensions",
                        N,
                        Entity (N));
-         Error_Msg_N ("?left operand " & Dimensions_Msg_Of (L), N);
-         Error_Msg_N ("?right operand " & Dimensions_Msg_Of (R), N);
-      end Error_Dim_For_Binary_Op;
+         Error_Msg_N ("\left operand " & Dimensions_Msg_Of (L), N);
+         Error_Msg_N ("\right operand " & Dimensions_Msg_Of (R), N);
+      end Error_Dim_Msg_For_Binary_Op;
 
    --  Start of processing for Analyze_Dimension_Binary_Op
 
@@ -1110,7 +1117,7 @@ package body Sem_Dim is
                --  Check both operands have same dimension
 
                if Dims_Of_L /= Dims_Of_R then
-                  Error_Dim_For_Binary_Op (N, L, R);
+                  Error_Dim_Msg_For_Binary_Op (N, L, R);
                else
                   --  Check both operands are not dimensionless
 
@@ -1216,7 +1223,7 @@ package body Sem_Dim is
                if (L_Has_Dimensions or R_Has_Dimensions)
                  and then Dims_Of_L /= Dims_Of_R
                then
-                  Error_Dim_For_Binary_Op (N, L, R);
+                  Error_Dim_Msg_For_Binary_Op (N, L, R);
                end if;
             end if;
 
@@ -1239,26 +1246,26 @@ package body Sem_Dim is
       Dims_Of_Etyp : constant Dimension_Type := Dimensions_Of (Etyp);
       Dims_Of_Expr : Dimension_Type;
 
-      procedure Error_Dim_For_Component_Declaration
+      procedure Error_Dim_Msg_For_Component_Declaration
         (N    : Node_Id;
          Etyp : Entity_Id;
          Expr : Node_Id);
-      --  Error using Error_Msg_N at node N. Output in the error message the
-      --  dimensions of the type Etyp and the expression Expr of N.
+      --  Error using Error_Msg_N at node N. Output the dimensions of the
+      --  type Etyp and the expression Expr of N.
 
-      -----------------------------------------
-      -- Error_Dim_For_Component_Declaration --
-      -----------------------------------------
+      ---------------------------------------------
+      -- Error_Dim_Msg_For_Component_Declaration --
+      ---------------------------------------------
 
-      procedure Error_Dim_For_Component_Declaration
+      procedure Error_Dim_Msg_For_Component_Declaration
         (N    : Node_Id;
          Etyp : Entity_Id;
          Expr : Node_Id) is
       begin
-         Error_Msg_N ("?dimensions mismatch in component declaration", N);
-         Error_Msg_N ("\?component type " & Dimensions_Msg_Of (Etyp), N);
-         Error_Msg_N ("\?component expression " & Dimensions_Msg_Of (Expr), N);
-      end Error_Dim_For_Component_Declaration;
+         Error_Msg_N ("dimensions mismatch in component declaration", N);
+         Error_Msg_N ("\component type " & Dimensions_Msg_Of (Etyp), N);
+         Error_Msg_N ("\component expression " & Dimensions_Msg_Of (Expr), N);
+      end Error_Dim_Msg_For_Component_Declaration;
 
    --  Start of processing for Analyze_Dimension_Component_Declaration
 
@@ -1270,7 +1277,7 @@ package body Sem_Dim is
          --  dimension of the type mismatch.
 
          if Dims_Of_Etyp /= Dims_Of_Expr then
-            Error_Dim_For_Component_Declaration (N, Etyp, Expr);
+            Error_Dim_Msg_For_Component_Declaration (N, Etyp, Expr);
          end if;
 
          --  Removal of dimensions in expression
@@ -1296,31 +1303,31 @@ package body Sem_Dim is
       Return_Obj_Decl       : Node_Id;
       Return_Obj_Id         : Entity_Id;
 
-      procedure Error_Dim_For_Extended_Return_Statement
+      procedure Error_Dim_Msg_For_Extended_Return_Statement
         (N             : Node_Id;
          Return_Etyp   : Entity_Id;
          Return_Obj_Id : Entity_Id);
-      --  Warning using Error_Msg_N at node N. Output in the error message the
-      --  dimensions of the returned type Return_Etyp and the returned object
-      --  Return_Obj_Id of N.
+      --  Error using Error_Msg_N at node N. Output the dimensions of the
+      --  returned type Return_Etyp and the returned object Return_Obj_Id of N.
 
-      ---------------------------------------------
-      -- Error_Dim_For_Extended_Return_Statement --
-      ---------------------------------------------
+      -------------------------------------------------
+      -- Error_Dim_Msg_For_Extended_Return_Statement --
+      -------------------------------------------------
 
-      procedure Error_Dim_For_Extended_Return_Statement
+      procedure Error_Dim_Msg_For_Extended_Return_Statement
         (N             : Node_Id;
          Return_Etyp   : Entity_Id;
          Return_Obj_Id : Entity_Id)
       is
       begin
-         Error_Msg_N ("?dimensions mismatch in extended return statement", N);
-         Error_Msg_N ("?returned type " & Dimensions_Msg_Of (Return_Etyp), N);
-         Error_Msg_N ("?returned object " & Dimensions_Msg_Of (Return_Obj_Id),
+         Error_Msg_N ("dimensions mismatch in extended return statement", N);
+         Error_Msg_N ("\returned type " & Dimensions_Msg_Of (Return_Etyp), N);
+         Error_Msg_N ("\returned object " & Dimensions_Msg_Of (Return_Obj_Id),
                       N);
-      end Error_Dim_For_Extended_Return_Statement;
+      end Error_Dim_Msg_For_Extended_Return_Statement;
 
    --  Start of processing for Analyze_Dimension_Extended_Return_Statement
+
    begin
       if Present (Return_Obj_Decls) then
          Return_Obj_Decl := First (Return_Obj_Decls);
@@ -1332,7 +1339,7 @@ package body Sem_Dim is
                   Dims_Of_Return_Obj_Id := Dimensions_Of (Return_Obj_Id);
 
                   if Dims_Of_Return_Etyp /= Dims_Of_Return_Obj_Id then
-                     Error_Dim_For_Extended_Return_Statement
+                     Error_Dim_Msg_For_Extended_Return_Statement
                        (N, Return_Etyp, Return_Obj_Id);
                      return;
                   end if;
@@ -1355,7 +1362,7 @@ package body Sem_Dim is
       Dims_Of_Actual : Dimension_Type;
       Dims_Of_Call   : Dimension_Type;
 
-      function Is_Elementary_Function_Call (N : Node_Id) return Boolean;
+      function Is_Elementary_Function_Call return Boolean;
       --  Return True if the call is a call of an elementary function (see
       --  Ada.Numerics.Generic_Elementary_Functions).
 
@@ -1363,13 +1370,11 @@ package body Sem_Dim is
       -- Is_Elementary_Function_Call --
       ---------------------------------
 
-      function Is_Elementary_Function_Call (N : Node_Id) return Boolean is
+      function Is_Elementary_Function_Call return Boolean is
          Ent : Entity_Id;
 
       begin
-         --  Note that the node must come from source (why not???)
-
-         if Comes_From_Source (N) and then Is_Entity_Name (Name_Call) then
+         if Is_Entity_Name (Name_Call) then
             Ent := Entity (Name_Call);
 
             --  Check the procedure is defined in an instantiation of a generic
@@ -1395,7 +1400,7 @@ package body Sem_Dim is
    begin
       --  Elementary function case
 
-      if Is_Elementary_Function_Call (N) then
+      if Is_Elementary_Function_Call then
 
          --  Sqrt function call case
 
@@ -1421,11 +1426,12 @@ package body Sem_Dim is
                Dims_Of_Actual := Dimensions_Of (Actual);
 
                if Exists (Dims_Of_Actual) then
-                  Error_Msg_NE
-                    ("?parameter should be dimensionless for elementary "
-                     & "function&", Actual, Name_Call);
-                  Error_Msg_N
-                    ("?parameter " & Dimensions_Msg_Of (Actual), Actual);
+                  Error_Msg_NE ("parameter should be dimensionless for " &
+                                "elementary function&",
+                                Actual,
+                                Name_Call);
+                  Error_Msg_N ("\parameter " & Dimensions_Msg_Of (Actual),
+                               Actual);
                end if;
 
                Next (Actual);
@@ -1446,7 +1452,6 @@ package body Sem_Dim is
    procedure Analyze_Dimension_Has_Etype (N : Node_Id) is
       Etyp         : constant Entity_Id := Etype (N);
       Dims_Of_Etyp : constant Dimension_Type := Dimensions_Of (Etyp);
-      N_Kind       : constant Node_Kind := Nkind (N);
 
    begin
       --  Propagation of the dimensions from the type
@@ -1457,31 +1462,35 @@ package body Sem_Dim is
 
       --  Removal of dimensions in expression
 
-      --  Wouldn't a case statement be clearer here???
+      case Nkind (N) is
 
-      if Nkind_In (N_Kind, N_Attribute_Reference, N_Indexed_Component) then
-         declare
-            Expr  : Node_Id;
-            Exprs : constant List_Id := Expressions (N);
-         begin
-            if Present (Exprs) then
-               Expr := First (Exprs);
-               while Present (Expr) loop
-                  Remove_Dimensions (Expr);
-                  Next (Expr);
-               end loop;
-            end if;
-         end;
+         when N_Attribute_Reference |
+              N_Indexed_Component   =>
+            declare
+               Expr  : Node_Id;
+               Exprs : constant List_Id := Expressions (N);
 
-      elsif Nkind_In (N_Kind, N_Qualified_Expression,
-                              N_Type_Conversion,
-                              N_Unchecked_Type_Conversion)
-      then
-         Remove_Dimensions (Expression (N));
+            begin
+               if Present (Exprs) then
+                  Expr := First (Exprs);
+                  while Present (Expr) loop
+                     Remove_Dimensions (Expr);
+                     Next (Expr);
+                  end loop;
+               end if;
+            end;
 
-      elsif N_Kind = N_Selected_Component then
-         Remove_Dimensions (Selector_Name (N));
-      end if;
+         when N_Qualified_Expression      |
+              N_Type_Conversion           |
+              N_Unchecked_Type_Conversion =>
+            Remove_Dimensions (Expression (N));
+
+         when N_Selected_Component =>
+            Remove_Dimensions (Selector_Name (N));
+
+         when others => null;
+
+      end case;
    end Analyze_Dimension_Has_Etype;
 
    ------------------------------------------
@@ -1495,26 +1504,26 @@ package body Sem_Dim is
       Dim_Of_Etyp : constant Dimension_Type := Dimensions_Of (Etyp);
       Dim_Of_Expr : Dimension_Type;
 
-      procedure Error_Dim_For_Object_Declaration
+      procedure Error_Dim_Msg_For_Object_Declaration
         (N    : Node_Id;
          Etyp : Entity_Id;
          Expr : Node_Id);
-      --  Warnings using Error_Msg_N at node N. Output in the error message the
-      --  dimensions of the type Etyp and the ???
+      --  Error using Error_Msg_N at node N. Output the dimensions of the
+      --  type Etyp and of the expression Expr.
 
-      --------------------------------------
-      -- Error_Dim_For_Object_Declaration --
-      --------------------------------------
+      ------------------------------------------
+      -- Error_Dim_Msg_For_Object_Declaration --
+      ------------------------------------------
 
-      procedure Error_Dim_For_Object_Declaration
+      procedure Error_Dim_Msg_For_Object_Declaration
         (N    : Node_Id;
          Etyp : Entity_Id;
          Expr : Node_Id) is
       begin
-         Error_Msg_N ("?dimensions mismatch in object declaration", N);
-         Error_Msg_N ("\?object type " & Dimensions_Msg_Of (Etyp), N);
-         Error_Msg_N ("\?object expression " & Dimensions_Msg_Of (Expr), N);
-      end Error_Dim_For_Object_Declaration;
+         Error_Msg_N ("dimensions mismatch in object declaration", N);
+         Error_Msg_N ("\object type " & Dimensions_Msg_Of (Etyp), N);
+         Error_Msg_N ("\object expression " & Dimensions_Msg_Of (Expr), N);
+      end Error_Dim_Msg_For_Object_Declaration;
 
    --  Start of processing for Analyze_Dimension_Object_Declaration
 
@@ -1532,7 +1541,7 @@ package body Sem_Dim is
                              N_Integer_Literal)
            and then Dim_Of_Expr /= Dim_Of_Etyp
          then
-            Error_Dim_For_Object_Declaration (N, Etyp, Expr);
+            Error_Dim_Msg_For_Object_Declaration (N, Etyp, Expr);
          end if;
 
          --  Removal of dimensions in expression
@@ -1549,34 +1558,34 @@ package body Sem_Dim is
       Renamed_Name : constant Node_Id := Name (N);
       Sub_Mark     : constant Node_Id := Subtype_Mark (N);
 
-      procedure Error_Dim_For_Object_Renaming_Declaration
+      procedure Error_Dim_Msg_For_Object_Renaming_Declaration
         (N            : Node_Id;
          Sub_Mark     : Node_Id;
          Renamed_Name : Node_Id);
-      --  Error using Error_Msg_N at node N. Output in the error message the
-      --  dimensions of Sub_Mark and of Renamed_Name.
+      --  Error using Error_Msg_N at node N. Output the dimensions of
+      --  Sub_Mark and of Renamed_Name.
 
-      -----------------------------------------------
-      -- Error_Dim_For_Object_Renaming_Declaration --
-      -----------------------------------------------
+      ---------------------------------------------------
+      -- Error_Dim_Msg_For_Object_Renaming_Declaration --
+      ---------------------------------------------------
 
-      procedure Error_Dim_For_Object_Renaming_Declaration
+      procedure Error_Dim_Msg_For_Object_Renaming_Declaration
         (N            : Node_Id;
          Sub_Mark     : Node_Id;
          Renamed_Name : Node_Id) is
       begin
-         Error_Msg_N ("?dimensions mismatch in object renaming declaration",
+         Error_Msg_N ("dimensions mismatch in object renaming declaration",
                       N);
-         Error_Msg_N ("?type " & Dimensions_Msg_Of (Sub_Mark), N);
-         Error_Msg_N ("?renamed object " & Dimensions_Msg_Of (Renamed_Name),
+         Error_Msg_N ("\type " & Dimensions_Msg_Of (Sub_Mark), N);
+         Error_Msg_N ("\renamed object " & Dimensions_Msg_Of (Renamed_Name),
                       N);
-      end Error_Dim_For_Object_Renaming_Declaration;
+      end Error_Dim_Msg_For_Object_Renaming_Declaration;
 
    --  Start of processing for Analyze_Dimension_Object_Renaming_Declaration
 
    begin
       if Dimensions_Of (Renamed_Name) /= Dimensions_Of (Sub_Mark) then
-         Error_Dim_For_Object_Renaming_Declaration
+         Error_Dim_Msg_For_Object_Renaming_Declaration
            (N, Sub_Mark, Renamed_Name);
       end if;
    end Analyze_Dimension_Object_Renaming_Declaration;
@@ -1594,34 +1603,33 @@ package body Sem_Dim is
       Dims_Of_Return_Etyp : constant Dimension_Type :=
                               Dimensions_Of (Return_Etyp);
 
-      procedure Error_Dim_For_Simple_Return_Statement
+      procedure Error_Dim_Msg_For_Simple_Return_Statement
         (N           : Node_Id;
          Return_Etyp : Entity_Id;
          Expr        : Node_Id);
-      --  Error using Error_Msg_N at node N. Output in the error message
-      --  the dimensions of the returned type Return_Etyp and the returned
-      --  expression Expr of N.
+      --  Error using Error_Msg_N at node N. Output the dimensions of the
+      --  returned type Return_Etyp and the returned expression Expr of N.
 
-      -------------------------------------------
-      -- Error_Dim_For_Simple_Return_Statement --
-      -------------------------------------------
+      -----------------------------------------------
+      -- Error_Dim_Msg_For_Simple_Return_Statement --
+      -----------------------------------------------
 
-      procedure Error_Dim_For_Simple_Return_Statement
+      procedure Error_Dim_Msg_For_Simple_Return_Statement
         (N           : Node_Id;
          Return_Etyp : Entity_Id;
          Expr        : Node_Id)
       is
       begin
-         Error_Msg_N ("?dimensions mismatch in return statement", N);
-         Error_Msg_N ("\?returned type " & Dimensions_Msg_Of (Return_Etyp), N);
-         Error_Msg_N ("\?returned expression " & Dimensions_Msg_Of (Expr), N);
-      end Error_Dim_For_Simple_Return_Statement;
+         Error_Msg_N ("dimensions mismatch in return statement", N);
+         Error_Msg_N ("\returned type " & Dimensions_Msg_Of (Return_Etyp), N);
+         Error_Msg_N ("\returned expression " & Dimensions_Msg_Of (Expr), N);
+      end Error_Dim_Msg_For_Simple_Return_Statement;
 
    --  Start of processing for Analyze_Dimension_Simple_Return_Statement
 
    begin
       if Dims_Of_Return_Etyp /= Dims_Of_Expr then
-         Error_Dim_For_Simple_Return_Statement (N, Return_Etyp, Expr);
+         Error_Dim_Msg_For_Simple_Return_Statement (N, Return_Etyp, Expr);
          Remove_Dimensions (Expr);
       end if;
    end Analyze_Dimension_Simple_Return_Statement;
@@ -1649,7 +1657,7 @@ package body Sem_Dim is
             --  it cannot inherit a dimension from its subtype.
 
             if Exists (Dims_Of_Id) then
-               Error_Msg_N ("?subtype& already" & Dimensions_Msg_Of (Id), N);
+               Error_Msg_N ("subtype& already" & Dimensions_Msg_Of (Id), N);
             else
                Set_Dimensions (Id, Dims_Of_Etyp);
                Set_Symbol (Id, Symbol_Of (Etyp));
@@ -1698,7 +1706,7 @@ package body Sem_Dim is
    --  RATIONAL ::= [-] NUMERAL [/ NUMERAL]
 
    --  A rational number is a number that can be expressed as the quotient or
-   --  fraction a/b of two integers, where b is non-zero.
+   --  fraction a/b of two integers, where b is non-zero positive.
 
    function Create_Rational_From
      (Expr     : Node_Id;
@@ -1889,7 +1897,7 @@ package body Sem_Dim is
 
       if Exists (Dims_Of_N) then
          System := System_Of (Base_Type (Etype (N)));
-         Add_Str_To_Name_Buffer ("has dimensions: ");
+         Add_Str_To_Name_Buffer ("has dimensions ");
          Add_Dimension_Vector_To_Buffer (Dims_Of_N, System);
       else
          Add_Str_To_Name_Buffer ("is dimensionless");
@@ -1914,8 +1922,7 @@ package body Sem_Dim is
    -- Eval_Op_Expon_For_Dimensioned_Type --
    ----------------------------------------
 
-   --  Evaluate the expon operator for real dimensioned type. Note that the
-   --  node must come from source. Why???
+   --  Evaluate the expon operator for real dimensioned type.
 
    --  Note that if the exponent is an integer (denominator = 1) the node is
    --  evaluated by the regular Eval_Op_Expon routine (see Sem_Eval).
@@ -1928,9 +1935,7 @@ package body Sem_Dim is
       R_Value : Rational := No_Rational;
 
    begin
-      if Comes_From_Source (N)
-        and then Is_Real_Type (Btyp)
-      then
+      if Is_Real_Type (Btyp) then
          R_Value := Create_Rational_From (R, False);
       end if;
 

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index adde2d6..0afe05c 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -4604,11 +4604,12 @@ package body Sem_Prag is
 
          elsif C = Convention_CPP
            and then (Is_Record_Type (Def_Id)
-                       or else Ekind (Def_Id) = E_Incomplete_Type)
+                      or else Ekind (Def_Id) = E_Incomplete_Type)
          then
             if Ekind (Def_Id) = E_Incomplete_Type then
                if Present (Full_View (Def_Id)) then
                   Def_Id := Full_View (Def_Id);
+
                else
                   Error_Msg_N
                     ("cannot import 'C'P'P type before full declaration seen",
@@ -4650,7 +4651,7 @@ package body Sem_Prag is
             --  full view is analyzed (see Process_Full_View).
 
             if not Is_Private_Type (Def_Id) then
-               Check_CPP_Type (Def_Id);
+               Check_CPP_Type_Has_No_Defaults (Def_Id);
             end if;
 
          elsif Nkind (Parent (Def_Id)) = N_Incomplete_Type_Declaration then
@@ -4662,8 +4663,8 @@ package body Sem_Prag is
 
          else
             Error_Pragma_Arg
-              ("second argument of pragma% must be object, subprogram" &
-               " or incomplete type",
+              ("second argument of pragma% must be object, subprogram "
+               & "or incomplete type",
                Arg2);
          end if;