[PATCH v2 2/4] ada: Add description of -gnatw.u/-gnatw.U in user manual

[PATCH v2 2/4] ada: Add description of -gnatw.u/-gnatw.U in user manual

[Samuel Tardieu]

2007-11-05  Samuel Tardieu  <sam@rfc1149.net>

	* gnat_ugn.texi: Add description of new warning -gnatw.u/-gnatw.U.
---
 gcc/ada/gnat_ugn.texi |   12 ++++++++++++
 1 files changed, 12 insertions(+), 0 deletions(-)

diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 73862de..25f2414 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -5161,6 +5161,18 @@ This switch suppresses warnings for unused entities and packages.
 It also turns off warnings on unreferenced formals (and thus includes
 the effect of @option{-gnatwF}).
 
+@item -gnatw.u
+@emph{Activate warnings on unnecessary Unchecked_Access attributes.}
+@cindex @option{-gnatw.u} (@command{gcc})
+This switch activates warnings to be generated when the Access attribute
+could safely be used in place of the Unchecked_Access attribute.
+
+@item -gnatw.U
+@emph{Supress warnings on unnecessary Unchecked_Access attributes.}
+@cindex @option{-gnatw.U} (@command{gcc})
+This switch suppresses warnings to be generated when the Access attribute
+could safely be used in place of the Unchecked_Access attribute.
+
 @item -gnatwv
 @emph{Activate warnings on unassigned variables.}
 @cindex @option{-gnatwv} (@command{gcc})
-- 
1.5.3.5

[PATCH v2 1/4] ada: Generate warning on useless 'Unchecked_Access with -gnatw.u

[Samuel Tardieu]

New version of the -gnatw.u warning with more RTS files cleaned up,
usage added and enabling of this warning in -gnatg.

    gcc/ada/
	* opt.ads: New warning Warn_On_Useless_Unchecked_Access.

	* sem_attr.adb (Resolve_Attribute): Check for unnecessary use
	of 'Unchecked_Access when 'Access could safely be used. If
	Warn_On_Useless_Unchecked_Access is True, post a warning.

	* sem_warn.adb (Set_Dot_Warning_Switch): Activate/deactivate
	Warn_On_Useless_Unchecked_Access on -gnatw.u/-gnatw.U.
	(Set_Warning_Switch): Activate/deactivate this warning
	on -gnatwa/-gnatwA.

	* switch-c.adb (Scan_Front_End_Switches): Activate
	Warn_On_Useless_Unchecked_Access on -gnatg.

	* usage.adb (Usage): Document -gnatw.u and -gnatw.U.
---
 gcc/ada/opt.ads      |    6 ++++++
 gcc/ada/sem_attr.adb |   22 ++++++++++++++++++++++
 gcc/ada/sem_warn.adb |    8 ++++++++
 gcc/ada/switch-c.adb |   37 +++++++++++++++++++------------------
 gcc/ada/usage.adb    |    4 ++++
 5 files changed, 59 insertions(+), 18 deletions(-)

diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 00a9cef..8e118f3 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1258,6 +1258,12 @@ package Opt is
    --  which have a record representation clause but this component does not
    --  have a component clause. The default is that this warning is disabled.
 
+   Warn_On_Useless_Unchecked_Access : Boolean := False;
+   --  GNAT
+   --  Set to True to generate warnings on use of X'Unchecked_Access where
+   --  X'Access would have been legitimate. The default is that this warning
+   --  is disabled.
+
    type Warning_Mode_Type is (Suppress, Normal, Treat_As_Error);
    Warning_Mode : Warning_Mode_Type := Normal;
    --  GNAT, GNATBIND
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index ce66987..0056024 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -7673,6 +7673,28 @@ package body Sem_Attr is
                   Accessibility_Message;
                   return;
                end if;
+
+               --  Check whether Access could have been used instead of
+               --  Unchecked_Access. The check is disabled:
+               --    - when compiling a generic because the
+               --      accessibility level may not be known if, for
+               --      example, the instantiation happens in a local
+               --      declaration;
+               --    - when compiling an instance, as Access could be
+               --      permitted only in this particular case and
+               --      forbidden in others.
+
+               if Attr_Id = Attribute_Unchecked_Access
+                 and then Warn_On_Useless_Unchecked_Access
+                 and then not Inside_A_Generic
+                 and then not In_Instance
+                 and then Comes_From_Source (P)
+                 and then (Object_Access_Level (P) <= Type_Access_Level (Btyp)
+                   or else Ekind (Btyp) = E_Anonymous_Access_Type)
+               then
+                  Error_Msg_F
+                    ("?''Access attribute could be used here", P);
+               end if;
             end if;
 
             if Ekind (Btyp) = E_Access_Protected_Subprogram_Type
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 65ea957..53dd04d 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -2542,6 +2542,12 @@ package body Sem_Warn is
          when 'R' =>
             Warn_On_Object_Renames_Function     := False;
 
+         when 'u' =>
+            Warn_On_Useless_Unchecked_Access    := True;
+
+         when 'U' =>
+            Warn_On_Useless_Unchecked_Access    := False;
+
          when 'x' =>
             Warn_On_Non_Local_Exception         := True;
 
@@ -2584,6 +2590,7 @@ package body Sem_Warn is
             Warn_On_Unchecked_Conversion        := True;
             Warn_On_Unrecognized_Pragma         := True;
             Warn_On_Unrepped_Components         := True;
+            Warn_On_Useless_Unchecked_Access    := True;
 
          when 'A' =>
             Check_Unreferenced                  := False;
@@ -2611,6 +2618,7 @@ package body Sem_Warn is
             Warn_On_Unchecked_Conversion        := False;
             Warn_On_Unrecognized_Pragma         := False;
             Warn_On_Unrepped_Components         := False;
+            Warn_On_Useless_Unchecked_Access    := False;
 
          when 'b' =>
             Warn_On_Bad_Fixed_Value             := True;
diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index 76c47f2..50a100a 100644
--- a/gcc/ada/switch-c.adb
+++ b/gcc/ada/switch-c.adb
@@ -473,24 +473,25 @@ package body Switch.C is
 
                --  Set default warnings for -gnatg
 
-               Check_Unreferenced              := True;
-               Check_Unreferenced_Formals      := True;
-               Check_Withs                     := True;
-               Constant_Condition_Warnings     := True;
-               Implementation_Unit_Warnings    := True;
-               Ineffective_Inline_Warnings     := True;
-               Warn_On_Assumed_Low_Bound       := True;
-               Warn_On_Bad_Fixed_Value         := True;
-               Warn_On_Constant                := True;
-               Warn_On_Export_Import           := True;
-               Warn_On_Modified_Unread         := True;
-               Warn_On_No_Value_Assigned       := True;
-               Warn_On_Non_Local_Exception     := False;
-               Warn_On_Obsolescent_Feature     := True;
-               Warn_On_Redundant_Constructs    := True;
-               Warn_On_Object_Renames_Function := True;
-               Warn_On_Unchecked_Conversion    := True;
-               Warn_On_Unrecognized_Pragma     := True;
+               Check_Unreferenced               := True;
+               Check_Unreferenced_Formals       := True;
+               Check_Withs                      := True;
+               Constant_Condition_Warnings      := True;
+               Implementation_Unit_Warnings     := True;
+               Ineffective_Inline_Warnings      := True;
+               Warn_On_Assumed_Low_Bound        := True;
+               Warn_On_Bad_Fixed_Value          := True;
+               Warn_On_Constant                 := True;
+               Warn_On_Export_Import            := True;
+               Warn_On_Modified_Unread          := True;
+               Warn_On_No_Value_Assigned        := True;
+               Warn_On_Non_Local_Exception      := False;
+               Warn_On_Obsolescent_Feature      := True;
+               Warn_On_Redundant_Constructs     := True;
+               Warn_On_Object_Renames_Function  := True;
+               Warn_On_Unchecked_Conversion     := True;
+               Warn_On_Unrecognized_Pragma      := True;
+               Warn_On_Useless_Unchecked_Access := True;
 
                Set_GNAT_Style_Check_Options;
 
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index ae5ee42..9501758 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -421,6 +421,10 @@ begin
    Write_Line ("        T*   turn off warnings for tracking deleted code");
    Write_Line ("        u    turn on warnings for unused entity");
    Write_Line ("        U*   turn off warnings for unused entity");
+   Write_Line ("        .u   turn on warnings for unnecessary " &
+                                                  "unchecked access");
+   Write_Line ("        .U   turn off warnings for unnecessary " &
+                                                  "unchecked access");
    Write_Line ("        v*   turn on warnings for unassigned variable");
    Write_Line ("        V    turn off warnings for unassigned variable");
    Write_Line ("        w*   turn on warnings for wrong low bound assumption");
-- 
1.5.3.5

[PATCH v2 4/4] Use 'Access where appropriate.

[Samuel Tardieu]

    gcc/ada/
	* s-inmaop-posix.adb s-intman-vxworks.adb s-taprop-hpux-dce.adb
	s-taprop-irix.adb s-taprop-linux.adb s-taprop-lynxos.adb
	s-taprop-posix.adb s-taprop-tru64.adb s-taprop-vxworks.adb:
	Use 'Access instead of 'Unchecked_Access in second and third
	arguments of pthread_sigmask.
---
 gcc/ada/s-inmaop-posix.adb    |   10 +++++-----
 gcc/ada/s-intman-vxworks.adb  |    4 ++--
 gcc/ada/s-taprop-hpux-dce.adb |    4 ++--
 gcc/ada/s-taprop-irix.adb     |    4 ++--
 gcc/ada/s-taprop-linux.adb    |    4 ++--
 gcc/ada/s-taprop-lynxos.adb   |    4 ++--
 gcc/ada/s-taprop-posix.adb    |    2 +-
 gcc/ada/s-taprop-tru64.adb    |    4 ++--
 gcc/ada/s-taprop-vxworks.adb  |    4 ++--
 9 files changed, 20 insertions(+), 20 deletions(-)

diff --git a/gcc/ada/s-inmaop-posix.adb b/gcc/ada/s-inmaop-posix.adb
index 5cee625..a38d391 100644
--- a/gcc/ada/s-inmaop-posix.adb
+++ b/gcc/ada/s-inmaop-posix.adb
@@ -77,7 +77,7 @@ package body System.Interrupt_Management.Operations is
       pragma Assert (Result = 0);
       Result := sigaddset (Mask'Access, Signal (Interrupt));
       pragma Assert (Result = 0);
-      Result := pthread_sigmask (SIG_BLOCK, Mask'Unchecked_Access, null);
+      Result := pthread_sigmask (SIG_BLOCK, Mask'Access, null);
       pragma Assert (Result = 0);
    end Thread_Block_Interrupt;
 
@@ -95,7 +95,7 @@ package body System.Interrupt_Management.Operations is
       pragma Assert (Result = 0);
       Result := sigaddset (Mask'Access, Signal (Interrupt));
       pragma Assert (Result = 0);
-      Result := pthread_sigmask (SIG_UNBLOCK, Mask'Unchecked_Access, null);
+      Result := pthread_sigmask (SIG_UNBLOCK, Mask'Access, null);
       pragma Assert (Result = 0);
    end Thread_Unblock_Interrupt;
 
@@ -286,7 +286,7 @@ begin
 
       for Sig in 1 .. Signal'Last loop
          Result := sigaction
-           (Sig, null, Initial_Action (Sig)'Unchecked_Access);
+           (Sig, null, Initial_Action (Sig)'Access);
 
          --  ??? [assert 1]
          --  we can't check Result here since sigaction will fail on
@@ -326,12 +326,12 @@ begin
 
       --  The Keep_Unmasked signals should be unmasked for Environment task
 
-      Result := pthread_sigmask (SIG_UNBLOCK, mask'Unchecked_Access, null);
+      Result := pthread_sigmask (SIG_UNBLOCK, mask'Access, null);
       pragma Assert (Result = 0);
 
       --  Get the signal mask of the Environment Task
 
-      Result := pthread_sigmask (SIG_SETMASK, null, mask'Unchecked_Access);
+      Result := pthread_sigmask (SIG_SETMASK, null, mask'Access);
       pragma Assert (Result = 0);
 
       --  Setup the constants exported
diff --git a/gcc/ada/s-intman-vxworks.adb b/gcc/ada/s-intman-vxworks.adb
index 89071e7..a7c0b7f 100644
--- a/gcc/ada/s-intman-vxworks.adb
+++ b/gcc/ada/s-intman-vxworks.adb
@@ -86,9 +86,9 @@ package body System.Interrupt_Management is
       pragma Unreferenced (Result);
 
    begin
-      Result := pthread_sigmask (SIG_SETMASK, null, Mask'Unchecked_Access);
+      Result := pthread_sigmask (SIG_SETMASK, null, Mask'Access);
       Result := sigdelset (Mask'Access, signo);
-      Result := pthread_sigmask (SIG_SETMASK, Mask'Unchecked_Access, null);
+      Result := pthread_sigmask (SIG_SETMASK, Mask'Access, null);
 
       Map_And_Raise_Exception (signo);
    end Notify_Exception;
diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb
index 33ca89b..b962b89 100644
--- a/gcc/ada/s-taprop-hpux-dce.adb
+++ b/gcc/ada/s-taprop-hpux-dce.adb
@@ -193,8 +193,8 @@ package body System.Task_Primitives.Operations is
          Result :=
            pthread_sigmask
              (SIG_UNBLOCK,
-              Unblocked_Signal_Mask'Unchecked_Access,
-              Old_Set'Unchecked_Access);
+              Unblocked_Signal_Mask'Access,
+              Old_Set'Access);
          pragma Assert (Result = 0);
 
          raise Standard'Abort_Signal;
diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb
index 62264ca..0ca8cca 100644
--- a/gcc/ada/s-taprop-irix.adb
+++ b/gcc/ada/s-taprop-irix.adb
@@ -189,8 +189,8 @@ package body System.Task_Primitives.Operations is
 
          Result := pthread_sigmask
            (SIG_UNBLOCK,
-            Unblocked_Signal_Mask'Unchecked_Access,
-            Old_Set'Unchecked_Access);
+            Unblocked_Signal_Mask'Access,
+            Old_Set'Access);
          pragma Assert (Result = 0);
 
          raise Standard'Abort_Signal;
diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index b30fb24..8e0f241 100644
--- a/gcc/ada/s-taprop-linux.adb
+++ b/gcc/ada/s-taprop-linux.adb
@@ -211,8 +211,8 @@ package body System.Task_Primitives.Operations is
          Result :=
            pthread_sigmask
              (SIG_UNBLOCK,
-              Unblocked_Signal_Mask'Unchecked_Access,
-              Old_Set'Unchecked_Access);
+              Unblocked_Signal_Mask'Access,
+              Old_Set'Access);
          pragma Assert (Result = 0);
 
          raise Standard'Abort_Signal;
diff --git a/gcc/ada/s-taprop-lynxos.adb b/gcc/ada/s-taprop-lynxos.adb
index 8693fed..cc4e74a 100644
--- a/gcc/ada/s-taprop-lynxos.adb
+++ b/gcc/ada/s-taprop-lynxos.adb
@@ -200,8 +200,8 @@ package body System.Task_Primitives.Operations is
          Result :=
            pthread_sigmask
              (SIG_UNBLOCK,
-              Unblocked_Signal_Mask'Unchecked_Access,
-              Old_Set'Unchecked_Access);
+              Unblocked_Signal_Mask'Access,
+              Old_Set'Access);
          pragma Assert (Result = 0);
 
          raise Standard'Abort_Signal;
diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb
index f9b30ce..7d3df5c 100644
--- a/gcc/ada/s-taprop-posix.adb
+++ b/gcc/ada/s-taprop-posix.adb
@@ -226,7 +226,7 @@ package body System.Task_Primitives.Operations is
          --  Make sure signals used for RTS internal purpose are unmasked
 
          Result := pthread_sigmask (SIG_UNBLOCK,
-           Unblocked_Signal_Mask'Unchecked_Access, Old_Set'Unchecked_Access);
+           Unblocked_Signal_Mask'Access, Old_Set'Access);
          pragma Assert (Result = 0);
 
          raise Standard'Abort_Signal;
diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb
index 35acb26..0b4620b 100644
--- a/gcc/ada/s-taprop-tru64.adb
+++ b/gcc/ada/s-taprop-tru64.adb
@@ -197,8 +197,8 @@ package body System.Task_Primitives.Operations is
          Result :=
            pthread_sigmask
              (SIG_UNBLOCK,
-              Unblocked_Signal_Mask'Unchecked_Access,
-              Old_Set'Unchecked_Access);
+              Unblocked_Signal_Mask'Access,
+              Old_Set'Access);
          pragma Assert (Result = 0);
 
          raise Standard'Abort_Signal;
diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb
index 9af031a..54c4f82 100644
--- a/gcc/ada/s-taprop-vxworks.adb
+++ b/gcc/ada/s-taprop-vxworks.adb
@@ -200,8 +200,8 @@ package body System.Task_Primitives.Operations is
          Result :=
            pthread_sigmask
              (SIG_UNBLOCK,
-              Unblocked_Signal_Mask'Unchecked_Access,
-              Old_Set'Unchecked_Access);
+              Unblocked_Signal_Mask'Access,
+              Old_Set'Access);
          pragma Assert (Result = 0);
 
          raise Standard'Abort_Signal;
-- 
1.5.3.5

[PATCH v2 3/4] Interix was the only system to use a named sigset_t access type

[Samuel Tardieu]

    gcc/ada/
	* s-osinte-interix.ads: Remove type sigset_t_ptr and
	use access sigset_t instead as is one on other plaforms.
---
 gcc/ada/s-osinte-interix.ads |    6 ++----
 1 files changed, 2 insertions(+), 4 deletions(-)

diff --git a/gcc/ada/s-osinte-interix.ads b/gcc/ada/s-osinte-interix.ads
index 844e12c..860aee3 100644
--- a/gcc/ada/s-osinte-interix.ads
+++ b/gcc/ada/s-osinte-interix.ads
@@ -312,12 +312,10 @@ package System.OS_Interface is
       sig    : Signal) return   int;
    pragma Import (C, pthread_kill, "pthread_kill");
 
-   type sigset_t_ptr is access all sigset_t;
-
    function pthread_sigmask
      (how  : int;
-      set  : sigset_t_ptr;
-      oset : sigset_t_ptr) return int;
+      set  : access sigset_t;
+      oset : access sigset_t) return int;
    pragma Import (C, pthread_sigmask, "pthread_wrapper_sigprocmask");
 
    --------------------------
-- 
1.5.3.5

Re: [PATCH v2 4/4] Use 'Access where appropriate.

[Arnaud Charlet]

This patch is OK, with a fix to the changelog: you need to put commas
between filenames in addition to spaces. Please fix also gcc/ada/ChangeLog
for the other commits you've already done, thanks.

>     gcc/ada/
> 	* s-inmaop-posix.adb s-intman-vxworks.adb s-taprop-hpux-dce.adb
> 	s-taprop-irix.adb s-taprop-linux.adb s-taprop-lynxos.adb
> 	s-taprop-posix.adb s-taprop-tru64.adb s-taprop-vxworks.adb:
> 	Use 'Access instead of 'Unchecked_Access in second and third
> 	arguments of pthread_sigmask.